perm filename RALPH[2,KMC] blob
sn#006429 filedate 1972-01-13 generic text, type T, neo UTF8
00010 BEGIN
00020 %##############################################################################################################%
00030 %################################# ARTIFICIAL BELIEF SYSTEM #################################%
00040 %##############################################################################################################%
00050
00060
00070 %
00080 The following program is a model of an artificial belief system. It contains models of the credibility
00090 processes involved in the creation of a belief structure, and of change within that structure. It is capable of
00100 accepting data, arriving at a credibility figure for new propositions, and answering questions about its data
00110 base. It incorporates some versatility for altering its models.
00120
00130 The program normally runs in 40K of core, which includes 20000 (octal) words of Binary Program Space.
00140 %
00150
00160
00170
00180 % GLOBAL VARIABLES ARE MARKED WITH AN EXCLAMATION POINT (!). %
00190
00200 SPECIAL !ALPHA, !OMEGA, !OMEGA_FACTOR, !CRAT, !CRLF;
00210 SPECIAL !NEXTCHAR, !TERMINATOR, !SFLAG, !RFLAG, !QFLAG;
00220 SPECIAL !LEGALCAT, !LEGALCRED, !INFORMANT, !FIRST_TIME, !INFERENCE_MAX, !INPUT;
00230
00240 NEW !I, !SAVE, !USE, !FILES; SPECIAL !I, !SAVE, !USE, !FILES;
00250
00260
00270
00290 % PAGE 3 % DEFINE TALK_TIME PREFIX, QUESTION_TIME PREFIX, THINK_TIME PREFIX;
00300 % PAGE 4 % DEFINE CONCLUDE1 PREFIX, CONCLUDE2 PREFIX, CONCLUDE3 PREFIX;
00310 % PAGE 5 % DEFINE FORM_STATEMENTS PREFIX, FORM_RULES PREFIX, FORM_CATEGORIES PREFIX,
00320 FORM_VARIABLES PREFIX, FORM_SETS PREFIX, EXCH PREFIX, STORE_CATLIST PREFIX;
00330 % PAGE 6 % DEFINE FORM_CREDIBILITIES PREFIX, DIRECT_EVIDENCE PREFIX, FOUNDATION PREFIX, CONSISTENCY PREFIX,
00340 RE_EVALUATE PREFIX, QUANTIZE PREFIX, STRENGTH PREFIX, NUMERICAL_VALUE PREFIX;
00350 % PAGE 7 % DEFINE JOIN PREFIX, JOIN1 PREFIX, SPLIT PREFIX, ISTRUE PREFIX, ISTRUE1 PREFIX,
00370 ISFALSE PREFIX, ISFALSE1 PREFIX, NEGATIVE PREFIX, NEGATE PREFIX,
00380 NEGATE1 PREFIX, PROB PREFIX, POSS PREFIX, PHRASE PREFIX, SAY PREFIX,
00390 STATEMENTS PREFIX, CATEGORIZE PREFIX, INDF PREFIX, CONCEPTS PREFIX,
00400 LAST_ATOM PREFIX, PRINTSTER PREFIX, TPRINTSTR PREFIX, PRINTSTRING PREFIX,
00410 SORT PREFIX, TEST PREFIX;
00420 % PAGE 8 % DEFINE STORE_DEDUCTION PREFIX, STORE_CONCEPT PREFIX;
00430 % PAGE 9 % DEFINE PSAYS PREFIX, PSTATEMENTS PREFIX, PRULES PREFIX, PCONCLUSIONS PREFIX,
00440 PQUESTIONS PREFIX, PABOUT PREFIX, PVARIABLES PREFIX, PSETS PREFIX, PCRED PREFIX;
00450 % PAGE 10 % DEFINE READ_SENTENCE PREFIX, READ_SENTENCE1 PREFIX, SCANNER PREFIX,
00460 SCAN1 PREFIX, BLANK_SKIP PREFIX, ANALYZE PREFIX;
00480
00490 DEFINE SUFLIST1 ↓, RETURN %-1% 0 0; % SHOULD BE -1, BUT MLISP WON'T ALLOW IT! %
00500
00510
00520 % MACRO DEFINITIONS: %
00530
00540
00550 MACRO SUBJ (SENT); 'CAR CONS CDR SENT;
00560
00570
00580 MACRO VERB (SENT); 'CADR CONS CDR SENT;
00590
00600
00610 MACRO OBJ (SENT); 'CADDR CONS CDR SENT;
00620
00630
00640 MACRO ELEM (SENT); 'CADDDR CONS CDR SENT;
00650
00660
00670 MACRO NOTIN (X); <'NOT, 'MEMBER CONS CDR X>; % X = (NOTIN X L) %
00680
00690
00700 MACRO OF (X); <'GET, X[3], <'QUOTE, X[2]>>; % X = (OF INDICATOR ATOM) %
00710
00720
00730 MACRO SUFLIST1 (X); IF NUMBERP X[3] & X[3] ≤ 4 THEN % X = (SUFLIST L N) %
00740 <AT(SUBSTR("CDDDD", 1, X[3]+1) CAT "R"), X[2]>
00750 ELSE 'SUFLIST CONS CDR X;
00010 %##############################################################################################################%
00020 %###################################### DATA STRUCTURE ######################################%
00030 %##############################################################################################################%
00040 % The following is a diagram of the complete data structure used in the program.
00050
00060 PERSONS
00070 |___ PLIST (informant1 informant2 ... SELF)
00080 |___ CONCEPT_LIST (concept1 concept2 ...)
00090 |___ LEGALCATLIST (PERSONS POLITICS RELIGION WAR RACE MEDICINE OTHER)
00100 |___ LEGALCREDLIST (PERSONSCRED POLITICSCRED ...)
00110 |___ MAIN_INDICATORS (STATEMENTS RULES CONCLUSIONS QUESTIONS)
00120
00130 INFORMANT1
00140 |___ SETS (set_name1 set_name2 ...)
00150 |___ NEW_STATEMENTS (new_statement1 new_statement2 ...)
00160 |___ AALIST ( (concept1 . concept2) (concept3 . concept4) ...)
00170 |___ AASLIST ( (concept1 . concept2) (concept3 . concept4) ...)
00180 |___ credindicator1 <real number>
00190 |___ credindicator2 <real number>
00200 ...
00210
00220 INFORMANT2
00230 ...
00240
00250 CONCEPT1
00260 |___ SLENGTH <integer>
00270 |___ STATEMENTS (statement1 statement2 ...)
00280 |___ RULES (rule1 rule2 ...)
00290 |___ QUESTIONS (question1 question2 ...)
00300 |___ CONCLUSIONS (conclusion1 conclusion2 ...)
00310 |___ CATEGORIZED T
00320 |___ category1 T
00330 |___ category2 T
00340 ...
00350
00360 CONCEPT2
00370 ...
00380
00390 SET_NAME1
00400 |___ SET ( (concept1) (concept2) ...)
00410
00420 SET_NAME2
00430 ...
00440
00450 CATEGORY1
00460 |___ CATEGORY (concept1 concept2 ...)
00470 |___ CREDINDICATOR category"CRED"
00480 |___ LEGALCAT T
00490
00500 CATEGORY2
00510 ...
00520
00530
00540 STATEMENT = (subject (verb) object (set elements) credibility frequency source)
00550
00560 RULE = (short_statement1 short_statement2 credibility frequency)
00570
00580 QUESTION = conclusion = new_statement = short_statement
00590
00600 SHORT_STATEMENT = (subject (verb) object (set elements))
00610
00620 CREDIBILITY = <real number>
00630
00640 FREQUENCY = <integer>
00650
00660 SOURCE = <atom>
00670
00680 %
00010 %##############################################################################################################%
00020 %################## THE FOLLOWING ARE THE THREE MAIN SUPERVISORY FUNCTIONS ##################%
00030 %##############################################################################################################%
00040
00050 EXPR TALK_TIME (INF);
00060 BEGIN NEW TOKEN;
00070 IF INF ε PLIST OF 'PERSONS THEN
00080 BEGIN
00090 !FIRST_TIME ← NIL;
00100 ADDPROP('PERSONS, INF, 'COMBINE, 'PLIST);
00110 TPRINTSTR TERPRI("HELLO AGAIN, " CAT INF CAT ". GO AHEAD.")
00120 END ELSE
00130 BEGIN
00140 !FIRST_TIME ← T;
00150 IF INF EQ 'KEN THEN STORE_PERSON(INF, 90.0) ELSE STORE_PERSON(INF, 60.0);
00160 TPRINTSTR TERPRI(
00170
00180 "IT'S NICE TO MEET YOU, " CAT INF CAT ".
00200 YOU MAY TYPE STATEMENTS, QUESTIONS, OR RULES TO THE PROGRAM.
00210
00220 A STATEMENT IS OF THE FORM: <SUBJECT> <LINKING VERB> <OBJECT> .
00230 EXAMPLE: JOLLY OLD JOE IS A BIG FAT MAN.
00240
00250 A QUESTION IS OF THE SAME FORM, EXCEPT THAT THERE IS A
00260 QUESTION MARK (?) INSTEAD OF A PERIOD FOR PUNCTUATION.
00270 EXAMPLE: JOLLY OLD JOE IS A BIG FAT MAN?
00280
00290 IN MOST CASES YOU MAY INVERT THE VERB FOR QUESTIONS.
00300 EXAMPLE: IS JOLLY OLD JOE A BIG FAT MAN?
00310
00320 A RULE IS OF THE FORM: <STATEMENT> IMPLIES <STATEMENT> .
00330 EXAMPLE: X IS A JOLLY OLD MAN IMPLIES X IS A BIG FAT PERSON.
00340
00350 BE SURE TO PUNCTUATE EVERY LINE.
00360 OK, GO AHEAD. WHEN YOU FINISH, TYPE 'DONE'.")
00370
00380 END;
00390
00400 WHILE (TOKEN ← SCANNER IO(READCH(),"")) NEQ 'DONE DO % CYCLE UNTIL THE INFORMANT TYPES 'DONE'. %
00410 BEGIN NEW INPUT;
00420 !SFLAG ← !QFLAG ← !RFLAG ← NIL; % THESE FLAGS ARE SET BY READ_SENTENCE. %
00430 INPUT ← READ_SENTENCE TOKEN; % ONLY STATEMENTS, QUESTIONS, AND RULES ARE VALID INPUTS. %
00440 IF !SFLAG THEN STORE_STATEMENT(INF, INPUT) ELSE
00450 IF !RFLAG THEN STORE_RULE(INF, INPUT) ELSE
00460 IF !QFLAG THEN ANSWER(INF, INPUT)
00470 ELSE TPRINTSTR " SORRY, BAD INPUT. TRY AGAIN."
00480 END
00490 END;
00500
00510
00520 EXPR QUESTION_TIME (INF);
00530 BEGIN
00540 FORM_STATEMENTS INF;
00550 FORM_RULES INF;
00560 FORM_CATEGORIES INF;
00570 % FORM_VARIABLES INF; %
00580 FORM_SETS INF;
00590 IF !SAVE THEN OUTC(T,NIL) ALSO OUTC(NIL,T) % CLOSE THE SAVE FILE BECAUSE WE WON'T BE %
00600 END; % GETTING ANY INPUT FOR A WHILE. %
00610
00620
00630 EXPR THINK_TIME (INF);
00640 BEGIN
00650 TPRINTSTR TERPRI "THINKING";
00660 FORM_CREDIBILITIES 'SELF; % THIS IS TO TAKE CARE OF ANY DEDUCTIONS THAT ARE ALREADY AROUND. %
00670 FORM_CREDIBILITIES INF;
00680 RE_EVALUATE INF;
00690 RE_EVALUATE 'SELF
00700 END;
00010 %##############################################################################################################%
00020 %############################### QUESTION-ANSWERING ROUTINES ################################%
00030 %##############################################################################################################%
00040
00050 EXPR ANSWER (INF, QUESTION);
00060 BEGIN NEW Q, SJ, OJ, ANS, QUES;
00070 STORE_QUESTION(INF, QUESTION);
00080 SJ ← SUBJ(QUESTION); OJ ← OBJ(QUESTION); Q ← QUESTION↑3;
00090 % FIRST SEE IF WE CAN ANSWER THE QUESTION DIRECTLY. %
00100 FOR NEW IND IN '(NEW_STATEMENTS STATEMENTS CONCLUSIONS) DO NIL UNTIL ANS ←
00110 FOR NEW S IN IF IND EQ 'NEW_STATEMENTS THEN INF GET IND ELSE SJ GET IND COLLECT
00120 DIRECTLY(S, Q, INF, IND);
00130 IF ANS THEN RETURN REPLY(ANS, QUESTION, QUESTION, INF); % WE GOT AN ANSWER. %
00140 FOR QUES IN <QUESTION, NEGATIVE QUESTION> DO NIL UNTIL ANS ← % SEE IF WE CAN DEDUCE AN ANSWER. %
00150 FOR NEW R IN RULES(SJ,OJ) COLLECT CONCLUDE1 CONCLUDE(R, QUES, 0, INF);
00160 IF ANS THEN REPLY(ANS, QUESTION, QUES, INF) ELSE TPRINTSTR TERPRI "I DON'T KNOW.";
00170 END;
00180
00190
00200 EXPR DIRECTLY (ST, Q, INF, IND);
00210 IF LAST_ATOM ST EQ 'SELF THEN NIL ELSE % THIS ALLOWS CHAINING OF RULES BY PREVENTING ALL QUESTIONS
00220 FROM BEING ANSWERED WITH DEDUCTIONS. %
00230 IF ST↑3 = Q THEN <"YES, " CAT SAY ST CAT WHY(LAST_ATOM ST, IND)> ELSE
00240 IF ST SAMEAS Q THEN <"NO, BUT " CAT SAY ST CAT WHY(LAST_ATOM ST, IND)> ELSE
00250 IF ST OPPOF Q THEN <"NO, " CAT SAY ST CAT WHY(LAST_ATOM ST, IND)>
00260 ELSE NIL;
00270
00280
00290 EXPR CONCLUDE (RULE, QUESTION, INFERENCE_LEVEL, INF);
00300 BEGIN NEW R, S, X, IND, NEW_QUESTION;
00310 IF INFERENCE_LEVEL GREATERP !INFERENCE_MAX THEN RETURN NIL; % ONLY GO 'INFERENCE_MAX' LEVELS DEEP. %
00320 % TRY TO INFER A NEW QUESTION. %
00330 NEW_QUESTION ← INFER(SUBJ(QUESTION), VERB(QUESTION), OBJ(QUESTION), ELEMS(QUESTION), RULE);
00340 IF ¬NEW_QUESTION THEN RETURN NIL;
00350 % OTHERWISE WE HAVE A NEW QUESTION TO ATTEMPT TO ANSWER.
00360 ANSWERING IT WILL THEN ANSWER THE ORIGINAL QUESTION VIA THE RULE 'RULE'.
00370 FIRST TRY THE RELEVANT STATEMENTS AND CONCLUSIONS:
00380 %
00390 FOR IND IN '(NEW_STATEMENTS STATEMENTS CONCLUSIONS) DO
00400 FOR S IN IF IND EQ 'NEW_STATEMENTS THEN INF GET IND ELSE SUBJ(NEW_QUESTION) GET IND DO NIL
00410 UNTIL S SAMEAS NEW_QUESTION
00420 UNTIL S;
00430 IF S THEN RETURN <<QUESTION, RULE, NEW_QUESTION, S, IND>>;
00440 % IF THAT FAILED, THEN TRY TO DEDUCE THE NEW QUESTION. %
00450 INFERENCE_LEVEL ← INFERENCE_LEVEL + 1;
00460 FOR R IN RULES(SUBJ(NEW_QUESTION), OBJ(NEW_QUESTION)) DO NIL
00470 UNTIL R ≠ RULE & X ← CONCLUDE(R, NEW_QUESTION, INFERENCE_LEVEL, INF);
00480 IF X THEN RETURN <QUESTION, RULE, NEW_QUESTION, R, 'RULES> CONS X
00490 END;
00500
00510 % THE FOLLOWING FIVE FUNCTIONS ARE FAIRLY INCOMPREHENSIBLE. %
00520
00530
00540 EXPR CONCLUDE1 (L); IF NULL L THEN NIL ELSE <CONCLUDE2 L>;
00550
00560
00570 EXPR CONCLUDE2 (L);
00580 IF NULL CDR L THEN CONCLUDE3 CAR L ELSE CONCLUDE4(CONCLUDE3 CAR L, CONCLUDE2 CDR L);
00590
00600
00610 EXPR CONCLUDE3 (L); CONCLUDE5(L[1], L[2], L[3], L[4], L[5]);
00620
00630
00640 EXPR CONCLUDE4 (FIRST, REST);
00650 IF REST & (SUBSTR(REST,1,5) SEQ "YES, ") THEN FIRST CAT ", AND" CAT SUBSTR(REST,5,'ALL) ELSE NIL;
00660
00670
00680 EXPR CONCLUDE5 (QUESTION, RULE, NEW_QUESTION, S, IND);
00690 (IF OBJ(NEW_QUESTION) EQ OBJ(RULE[1]) THEN "YES, " CAT SAY QUESTION ELSE "NO, "
00700 CAT SAY NEGATIVE QUESTION) CAT "BECAUSE " CAT SAY RULE[1] CAT "IMPLIES " CAT SAY RULE[2]
00710 CAT "(ACCORDING TO " CAT LAST_ATOM RULE CAT (IF IND EQ 'RULES THEN ")" ELSE "), AND " CAT SAY S
00720 CAT WHY(LAST_ATOM S, IND));
00730
00740
00750 EXPR REPLY (ANS, QUESTION, QUES, INF);
00760 BEGIN
00770 TERPRI FOR NEW I IN ANS DO PRINTSTRING
00780 IF QUES = QUESTION THEN I ELSE
00790 IF SUBSTR(I,1,3) SEQ "YES" THEN "NO" CAT SUBSTR(I,4,'ALL) ELSE
00800 IF SUBSTR(I,1,8) SEQ "NO, BUT " THEN "YES, " CAT SUBSTR(I,9,'ALL)
00810 ELSE "YES" CAT SUBSTR(I,3,'ALL); % ANSWER WAS "NO, ...." %
00820 IF ISTRUE ANS THEN STORE_CONCLUSION(INF, QUES) ELSE
00830 IF ISFALSE ANS THEN STORE_CONCLUSION(INF, NEGATIVE QUES)
00840 END;
00850
00860
00870 EXPR WHY (INF, IND);
00880 IF IND EQ 'NEW_STATEMENTS THEN "(ACCORDING TO " CAT !INFORMANT CAT ")" ELSE
00890 IF IND EQ 'CONCLUSIONS THEN "(A PREVIOUS CONCLUSION)" ELSE
00900 IF INF EQ 'SELF THEN "(A DEDUCTION)"
00910 ELSE "(ACCORDING TO " CAT INF CAT ")";
00010 %##############################################################################################################%
00020 %################################# QUESTION_TIME FUNCTIONS ##################################%
00030 %##############################################################################################################%
00040
00050 EXPR FORM_STATEMENTS (INF);
00060 BEGIN NEW !AASLIST, !QUESLIST, SLIST, NEW_SLIST;
00070 SPECIAL !AASLIST, !QUESLIST;
00080 IF !FIRST_TIME THEN TPRINTSTR TERPRI
00090
00100 "NOW I WOULD LIKE TO ASK YOU A FEW QUESTIONS.
00110 PLEASE ANSWER YES, CERTAINLY, PROBABLY, POSSIBLY, NO,
00120 OR X (FOR NO RELATIONSHIP)."
00130
00140 ELSE TPRINTSTR TERPRI "STATEMENT FORMATION";
00150 !AASLIST ← AASLIST OF INF; % THIS IS THE INFORMANT'S "ALREADY-ASKED STATEMENT LIST". %
00160 NEW_SLIST ← NEW_STATEMENTS OF INF;
00170 SLIST ← NEW_SLIST @ STATEMENTS(INF);
00180 FOR NEW S IN SLIST DO !QUESLIST ← (SUBJ(S) CONS OBJ(S)) CONS !QUESLIST;
00190 !QUESLIST ← !AASLIST @ !QUESLIST;
00200 FOR NEW S IN NEW_SLIST DO
00210 BEGIN NEW NEW_SUBJECT, ELS, SIMILAR; % THIS GETS DONE FOR EACH NEW STATEMENT. %
00220 NEW_SUBJECT ← SUBJ(S); % THE NEW SUBJECT. %
00230 SIMILAR ← SIMSUBJS OF NEW_SUBJECT; % THE LIST OF SUBJECTS HAVING SOME SIMILARITY TO NEW_SUBJECT. %
00240 IF SIMILAR EQ 'NONE THEN RETURN NIL ELSE
00250 % WE HAVE ALREADY DISCUSSED THIS SUBJECT AND HAVE FOUND NO SUBJECTS SIMILAR TO IT. %
00260 IF ¬SIMILAR & ¬ SIMILAR ← ANY_SIMILARITY(NEW_SUBJECT, SLIST, NIL) THEN
00270 RETURN PUTPROP(NEW_SUBJECT, 'NONE, 'SIMSUBJS)
00280 % WE HAVEN'T ALREADY DISCUSSED THIS SUBJECT, BUT NEITHER COULD WE FIND ANY SUBJECTS SIMILAR TO IT. %
00290 ELSE PUTPROP(NEW_SUBJECT, SIMILAR, 'SIMSUBJS);
00300 % THIS INSURES THAT WE WON'T HAVE TO GO THROUGH THIS MESS AGAIN IF THE SAME SUBJECT IS DISCUSSED
00310 IN ANOTHER NEW STATEMENT. %
00320 FOR NEW OPP IN SIMILAR DO % SIMILAR = ((SUBJ1 . ELEMS1) (SUBJ2 . ELEMS2) ... ) %
00330 BEGIN NEW OPPSJ, OPPOJ; % ASK IF ANY OF THE SIMILAR SUBJECTS IS AN 'OJ', %
00340 OPPSJ ← CAR OPP; % OR ANY OF THE OTHER THINGS THE NEW SUBJECT IS. %
00350 FOR NEW I IN S CONS NEW_SUBJECT GET 'STATEMENTS DO IF (OPPSJ CONS OBJ(I)) NOTIN !QUESLIST THEN
00360 BEGIN NEW QUES;
00370 !QUESLIST ← (OPPSJ CONS OBJ(I)) CONS !QUESLIST;
00380 QUES ← <OPPSJ, VERB(I), OBJ(I), <CDR OPP, ELEMO(I)>>;
00390 PRINTSTRING( SAY(JOIN(CAR VERB(QUES) CONS SPLIT SUBJ(QUES)) CONS CDR VERB(QUES) CONS QUES↓2)
00400 CAT "?");
00410 STEST(SCANNER IO(READCH(),""), INF, QUES)
00420 END;
00430 % ALSO ASK IF THE NEW SUBJECT IS ANY OF THE THINGS AN OPPONENT IS. %
00440 FOR NEW I IN OPPSJ GET 'STATEMENTS DO
00450 IF SUBJ(I) EQ OPPSJ & WHO(I) EQ INF & (NEW_SUBJECT CONS OPPOJ ← OBJ(I)) NOTIN !QUESLIST THEN
00460 BEGIN NEW QUES;
00470 !QUESLIST ← (NEW_SUBJECT CONS OPPOJ) CONS !QUESLIST;
00480 QUES ← <NEW_SUBJECT, VERB(I), OPPOJ, <ELS, ELEMO(I)>>;
00490 PRINTSTRING( SAY(JOIN(CAR VERB(I) CONS SPLIT NEW_SUBJECT) CONS CDR VERB(I) CONS QUES↓2)
00500 CAT "?");
00510 STEST(SCANNER IO(READCH(),""), INF, QUES)
00520 END
00530 END
00540 END;
00550 PUTPROP(INF, !AASLIST, 'AASLIST); % THE 'AASLIST' MIGHT HAVE BEEN MODIFIED BY 'STEST'. %
00560 FOR NEW S IN NEW_SLIST DO REMPROP(SUBJ(S), 'SIMSUBJS)
00570 END;
00580
00590
00600 EXPR FORM_RULES (INF);
00610 % THIS TRIES TO RELATE CONCEPTS VIA RULES. %
00620 BEGIN NEW !AALIST, !QUESLIST, L, NEW_SLIST;
00630 SPECIAL !AALIST, !QUESLIST;
00640 IF ¬!FIRST_TIME THEN TPRINTSTR TERPRI "RULE FORMATION";
00650 % THE 'AALIST' IS THE 'ALREADY-ASKED LIST'. %
00660 FOR NEW I IN AALIST OF INF DO !AALIST ← I CONS EXCH(I) CONS !AALIST;
00670 NEW_SLIST ← NEW_STATEMENTS OF INF;
00680 FOR NEW CONCEPT IN CONCEPT_LIST OF 'PERSONS DO
00690 FOR NEW R IN RULES OF CONCEPT DO !QUESLIST ← (OBJ(R[1]) CONS OBJ(R[2])) CONS !QUESLIST;
00700 !QUESLIST ← !AALIST @ !QUESLIST;
00710 FOR NEW S1 IN NEW_SLIST DO
00720 BEGIN NEW SJ1, OJ1, LH, OJ2;
00730 % THIS IS DONE FOR EACH NEW STATEMENT. %
00740 IF 'NOT ε VERB(S1) THEN RETURN NIL; % DON'T ASK FOR RULES IN THE FORM: ¬P => Q %
00750 SJ1 ← SUBJ(S1); OJ1 ← OBJ(S1); LH ← <'X, VERB(S1), OJ1, <NIL, ELEMO(S1)>>;
00760 FOR NEW S2 IN NEW_OLD(INF, NEW_SLIST, SJ1) DO
00770 IF SJ1 EQ SUBJ(S2) & OJ1 NEQ OJ2 ← OBJ(S2) THEN
00780 BEGIN NEW !FLAG, RH, OJ1OJ2; SPECIAL !FLAG;
00790 RH ← <'X, VERB(S2), OJ2, <NIL, ELEMO(S2)>>;
00800 FOR NEW QUES IN < <LH, RH>, <RH, LH> > DO
00810 IF (OJ1OJ2 ← OBJ(QUES[1]) CONS OBJ(QUES[2])) NOTIN !QUESLIST THEN
00820 BEGIN
00830 % ADD THE QUESTION TO THE QUESLIST SO THAT IT WON'T BE ASKED AGAIN. %
00840 % QUESLIST IS A LIST OF ALL THE STATEMENTS EITHER ALREADY ASKED OR ALREADY EXISTING. %
00850 !QUESLIST ← OJ1OJ2 CONS !QUESLIST;
00860 PRINTSTRING("DOES " CAT SAY QUES[1] CAT "IMPLY " CAT SAY QUES[2] CAT "?");
00870 IF ¬RTEST(SCANNER IO(READCH(),""), INF, QUES) THEN
00880 BEGIN
00890 QUES ← <QUES[1], NEGATIVE QUES[2]>;
00900 PRINTSTRING("THEN DOES " CAT SAY QUES[1] CAT "IMPLY " CAT SAY QUES[2] CAT "?");
00910 % ADD THE QUESTION TO THE 'ALREADY-ASKED LIST' ONLY IF IT WAS NOT STORED AS A RULE. %
00920 IF ¬RTEST(SCANNER IO(READCH(),""), INF, QUES) THEN !AALIST ← OJ1OJ2 CONS !AALIST
00930 END
00940 END
00950 UNTIL !FLAG
00960 END
00970 END;
00980 % PARE THE AALIST DOWN SO THAT EACH ELEMENT IS ONLY STORED ONCE, I.E. NOT BOTH I AND EXCH(I). %
00990 FOR NEW I IN !AALIST DO IF I NOTIN L & EXCH(I) NOTIN L THEN L ← I CONS L;
01000 PUTPROP(INF, L, 'AALIST)
01010 END;
01020
01030
01040 EXPR FORM_CATEGORIES (INF);
01050 % THIS ORGANIZES THE VARIOUS CONCEPTS INTO CATEGORIES. %
01060 BEGIN NEW CONCEPT;
01070 IF !FIRST_TIME THEN TPRINTSTR TERPRI(
01080
01090 "NOW I WOULD LIKE FOR YOU TO CATEGORIZE SOME INFORMATION.
01100 I WILL TYPE OUT A CONCEPT, FOLLOWED BY A QUESTION MARK.
01110 YOU TYPE ONE OR MORE CATEGORIES WITH WHICH YOU THINK THE CONCEPT
01120 IS ASSOCIATED, SEPARATED BY COMMAS.
01130 FOR EXAMPLE: NIXON ? POLITICS, PERSONS, RACE
01140 THE CHOICES ARE: " CAT !LEGALCAT)
01150
01160 ELSE TPRINTSTR TERPRI(
01170
01180 "CATEGORY CLASSIFICATION
01190 THE CHOICES ARE: " CAT !LEGALCAT);
01200
01210 FOR NEW CONCEPT IN CONCEPT_LIST OF 'PERSONS DO
01220 IF ¬GET(CONCEPT,'CATEGORIZED) THEN
01230 BEGIN
01240 PRINTSTR((FOR NEW I IN SPLIT CONCEPT; CAT I CAT BLANK) CAT "?");
01250 TERPRI STORE_CATLIST CONCEPT
01260 END;
01270 PRINTSTR "ANY CHANGES ?";
01280 IF SCANNER IO(READCH(),"") EQ 'NO THEN RETURN NIL;
01290 TPRINTSTR
01300
01310 "TYPE THE CONCEPT TO BE RECATEGORIZED, JOINED BY DASHES.
01320 FOLLOW IT WITH THE NEW LIST OF CATEGORIES.
01330 FOR EXAMPLE: THE-PRESIDENT-OF-THE-UNITED-STATES PERSONS, POLITICS.
01340 TYPE 'DONE' WHEN FINISHED.";
01350
01360 WHILE (CONCEPT ← IO(READ(), !CRLF)) NEQ 'DONE DO
01370 BEGIN
01380 FOR NEW CATEGORY IN !LEGALCAT DO IF CONCEPT GET CATEGORY THEN REMOVE_CATEGORY(CONCEPT, CATEGORY);
01390 STORE_CATLIST CONCEPT;
01400 TPRINTSTR " OK."
01410 END
01420 END;
01430
01440
01450 EXPR FORM_VARIABLES (INF);
01460 BEGIN NEW VARNAME;
01470 IF !FIRST_TIME THEN TPRINTSTR TERPRI
01480
01490 "YOU MAY NOW DEFINE VARIABLES HAVING CONJUNCTIVE PROPERTIES.
01500 TYPE THE VARIABLE, THEN THE PROPERTIES SEPARATED BY COMMAS.
01510 FOR EXAMPLE: WASP WHITE, ANGLO SAXON, PROTESTANT.
01520 TYPE 'DONE' WHEN FINISHED."
01530
01540 ELSE TPRINTSTR "VARIABLE FORMATION";
01550 WHILE (VARNAME ← IO(READ(), !CRLF)) NEQ 'DONE DO
01560 BEGIN NEW VARLIST;
01570 VARLIST ← COLLECT <JOIN PHRASE SCANNER IO(READCH(),"")> UNTIL GET(!NEXTCHAR,'ENDER);
01580 STORE_VARIABLE(INF, VARNAME, VARLIST);
01590 TPRINTSTR " OK."
01600 END
01610 END;
01620
01630
01640 EXPR FORM_SETS (INF);
01650 % THIS FORMS AND STORES SETS OF SYNONYMS. %
01660 BEGIN NEW MAIN_INDICATORS, SET_NAME;
01670 IF !FIRST_TIME THEN TPRINTSTR TERPRI
01680
01690 "NOW YOU MAY CREATE SETS OF SYNONYMOUS CONCEPTS,
01695 OR ADD TO ALREADY EXISTING SETS.
01700 TYPE A SET NAME, THEN THE CONCEPTS SEPARATED BY COMMAS.
01720 FOR EXAMPLE: NEGROSET BLACK MAN, NEGRO, AFRO AMERICAN
01730 TYPE 'DONE' WHEN FINISHED."
01740
01750 ELSE TPRINTSTR TERPRI "SET FORMATION";
01760 MAIN_INDICATORS ← MAIN_INDICATORS OF 'PERSONS;
01770 % MAIN_INDICATORS = (STATEMENTS RULES CONCLUSIONS QUESTIONS). %
01780 WHILE (SET_NAME ← IO(READ(), " ")) NEQ 'DONE DO FORM_SETS1(INF, MAIN_INDICATORS, SET_NAME)
01790 END;
01800
01810
01820 EXPR FORM_SETS1 (INF, MAIN_INDICATORS, SET_NAME);
01830 % THE FOLLOWING IS DONE FOR EVERY SET TYPED IN. %
01840 BEGIN NEW !CONCEPT_LIST, SET_LIST;
01850 SPECIAL !CONCEPT_LIST;
01860 % SORT THE SET LIST TO INSURE THAT THE LONGEST ELEMENTS WILL COME FIRST. %
01870 SET_LIST ← SORT REVERSE COLLECT <PHRASE SCANNER IO(READCH(),"")> UNTIL GET(!NEXTCHAR,'ENDER);
01880 !CONCEPT_LIST ← CONCEPT_LIST OF 'PERSONS;
01890 FOR NEW EL IN SET_LIST DO FORM_SETS2(INF, MAIN_INDICATORS, SET_NAME, EL);
01900 PUTPROP('PERSONS, !CONCEPT_LIST, 'CONCEPT_LIST); % 'CONCEPT_LIST' MAY HAVE BEEN CHANGED BY FS2. %
01910 % COMBINE THE NEW SET MEMBERS WITH THE OLD (IF ANY). %
01920 FOR NEW I IN SET OF SET_NAME DO SET_LIST ← I COMBINEL SET_LIST;
01930 STORE_SET(INF, SET_NAME, SET_LIST);
01940 TPRINTSTR " OK."
01950 END;
01960
01970
01980 EXPR FORM_SETS2 (INF, MAIN_INDICATORS, SET_NAME, EL);
01990 % DO THE FOLLOWING FOR EACH ELEMENT IN THE SET. %
02000 BEGIN NEW LEN, JEL;
02010 LEN ← LENGTH EL;
02020 JEL ← JOIN EL;
02030 FOR NEW CONCEPT IN !CONCEPT_LIST DO % CHECK EVERY CONCEPT FOR AN OCCURRENCE OF THE SET ELEMENT. %
02040 BEGIN NEW PAIR, NEW_CONCEPT;
02050 PAIR ← REP(EL, LEN, SET_NAME, CONCEPT, 0);
02060 NEW_CONCEPT ← CAR PAIR;
02070 IF NEW_CONCEPT NEQ CONCEPT THEN % THE OLD CONCEPT CONTAINED AN OCCURRENCE OF THE SET ELEMENT. %
02080 BEGIN NEW POSITION;
02090 POSITION ← CDR PAIR;
02100 % REPLACE ALL OCCURRENCES OF THE ELEMENT. %
02110 FOR NEW IND IN '(STATEMENTS CONCLUSIONS QUESTIONS) DO
02120 % A RPLACA 'IN' A LIST REPLACES ALL OCCURENCES IN MEMORY OF THAT LIST ELEMENT. %
02130 FOR NEW S IN CONCEPT GET IND DO SRPLACA(S, REPLACE(CONCEPT, NEW_CONCEPT, S, JEL, POSITION));
02140 % A RPLACA 'ON' A LIST REPLACES ONLY THAT OCCURENCE OF THE LIST ELEMENT OCCURRING IN THE LIST. %
02150 FOR NEW I IN <INF,'SELF> DO
02160 FOR NEW S ON NEW_STATEMENTS OF I DO
02170 RPLACA(S, REPLACE(CONCEPT, NEW_CONCEPT, CAR S, JEL, POSITION));
02180 FOR NEW R IN RULES OF CONCEPT DO
02190 BEGIN
02200 RPLACA(R, REPLACE(CONCEPT, NEW_CONCEPT, R[1], JEL, POSITION));
02210 RPLACA(CDR R, REPLACE(CONCEPT, NEW_CONCEPT, R[2], JEL, POSITION))
02220 END;
02230 % CHECK THE ALREADY ASKED LISTS. %
02240 FOR NEW IND IN '(AASLIST AALIST) DO
02250 FOR NEW I ON INF GET IND DO
02260 BEGIN
02270 IF CAAR I EQ CONCEPT THEN RPLACA(I, NEW_CONCEPT CONS CDAR I);
02280 IF CDAR I EQ CONCEPT THEN RPLACA(I, CAAR I CONS NEW_CONCEPT)
02290 END;
02300 % TRANSFER ALL THE OLD CONCEPT PROPERTIES TO THE NEW CONCEPT. %
02310 FOR NEW IND IN MAIN_INDICATORS DO
02320 ADDPROP(NEW_CONCEPT, CONCEPT GET IND, 'APPEND, IND);
02330 IF ¬(SLENGTH OF NEW_CONCEPT) THEN PUTPROP(NEW_CONCEPT, 0, 'SLENGTH);
02340 PUTPROP(NEW_CONCEPT, (SLENGTH OF CONCEPT) + (SLENGTH OF NEW_CONCEPT), 'SLENGTH);
02350 IF GET(CONCEPT,'CATEGORIZED) THEN
02360 BEGIN
02370 PUTPROP(NEW_CONCEPT, T, 'CATEGORIZED);
02380 FOR NEW CATEGORY IN !LEGALCAT DO % TRANSFER THE CATEGORIES, TOO. %
02390 IF CONCEPT GET CATEGORY THEN
02400 BEGIN
02410 STORE_CATEGORY(NEW_CONCEPT, CATEGORY);
02420 REMOVE_CATEGORY(CONCEPT, CATEGORY)
02430 END
02440 END;
02450 % NOW REMOVE ALL THOSE PROPERTIES FROM THE OLD CONCEPT'S PROPERTY LIST. %
02460 FOR NEW IND IN MAIN_INDICATORS @ '(SLENGTH CATEGORIZED) DO REMPROP(CONCEPT, IND);
02470 % FINALLY, REPLACE THE OLD CONCEPT WITH THE NEW ONE ON THE CONCEPT LIST. %
02480 !CONCEPT_LIST ← NEW_CONCEPT COMBINE REMOVE_ELEMENT(CONCEPT, !CONCEPT_LIST)
02490 END
02500 END
02510 END;
02520
02530
02540 EXPR ANY_SIMILARITY (S, L, SPECIAL !X);
02550 (FOR NEW I IN L DO IF SUBJ(I) EQ S THEN ANY_SIMILARITY1(S, OBJ(I), L)) PROG2 !X;
02560
02570
02580 EXPR ANY_SIMILARITY1 (S, O, L);
02590 FOR NEW I IN L DO IF OBJ(I) EQ O & SUBJ(I) NEQ S THEN !X ← (SUBJ(I) CONS ELEMS(I)) XCLCONS !X;
02600
02610
02620 EXPR EXCH (X); CDR X CONS CAR X; % EXCHANGES THE CAR AND THE CDR OF ITS ARGUMENT. %
02630
02640
02650 EXPR RTEST (ANS, INF, Q);
02660 IF ANS EQ 'YES | ANS EQ 'CERTAINLY THEN STORE_RULE(INF, Q) ELSE RTEST1(ANS, INF, Q[1], Q[2]);
02670
02680
02690 EXPR RTEST1 (ANS, INF, LH, RH);
02700 IF ANS EQ 'PROBABLY THEN STORE_RULE(INF, <LH, SUBJ(RH) CONS PROB VERB(RH) CONS RH↓2>) ELSE
02710 IF ANS EQ 'POSSIBLY THEN STORE_RULE(INF, <LH, SUBJ(RH) CONS POSS VERB(RH) CONS RH↓2>) ELSE
02720 IF ANS EQ 'NO THEN NIL ELSE
02730 IF ANS EQ 'X THEN !FLAG ← !QUESLIST ← (OBJ(RH) CONS OBJ(LH)) CONS !QUESLIST
02740 ALSO !AALIST ← (OBJ(LH) CONS OBJ(RH)) CONS !AALIST
02750 ELSE TPRINTSTR TERPRI "I DIDN'T UNDERSTAND THAT. TRY AGAIN."
02755 ALSO RTEST(SCANNER IO(READCH(),""), INF, <LH,RH>);
02760
02770
02780 EXPR STEST (ANS, INF, Q);
02790 IF ANS EQ 'YES | ANS EQ 'CERTAINLY THEN STORE_STATEMENT(INF, Q) ELSE
02800 IF ANS EQ 'PROBABLY THEN STORE_STATEMENT(INF, SUBJ(Q) CONS PROB VERB(Q) CONS Q↓2) ELSE
02810 IF ANS EQ 'POSSIBLY THEN STORE_STATEMENT(INF, SUBJ(Q) CONS POSS VERB(Q) CONS Q↓2) ELSE
02820 IF ANS EQ 'NO THEN STORE_STATEMENT(INF, NEGATIVE Q) ELSE
02830 IF ANS EQ 'X THEN !AASLIST ← (SUBJ(Q) CONS OBJ(Q)) CONS !AASLIST
02840 ELSE TPRINTSTR TERPRI "I DIDN'T UNDERSTAND THAT. TRY AGAIN."
02845 ALSO STEST(SCANNER IO(READCH(),""), INF, Q);
02850
02860
02870 EXPR STORE_CATLIST (CONCEPT);
02880 % THIS DOES THE ACTUAL SCANNING AND STORING OF THE TYPED CATEGORY LIST. %
02890 FOR NEW CATEGORY IN COLLECT <SCANNER IO(READCH(),"")> UNTIL GET(!NEXTCHAR,'ENDER) DO
02900 % 'STORE_CATEGORY' MARKS THE CONCEPT AS BEING CATEGORIZED. %
02910 IF GET(CATEGORY,'LEGALCAT) THEN STORE_CATEGORY(CONCEPT, CATEGORY)
02920 ELSE PRINTSTR(CATEGORY CAT " IS NOT A LEGAL CATEGORY.");
02930
02940
02950 EXPR REMOVE_CATEGORY (CONCEPT, CATGY);
02960 BEGIN
02970 % CONCEPTS ASSIGNED TO A CATEGORY ARE BOTH MARKED WITH THE CATEGORY AS AN INDICATOR AND ADDED TO A LIST
02980 OF OTHER CONCEPTS IN THE SAME CATEGORY. %
02990 REMPROP(CONCEPT, CATGY);
03000 PUTPROP(CATGY, REMOVE_ELEMENT(CONCEPT, CATEGORY OF CATGY), 'CATEGORY)
03010 END;
03020
03030
03040 EXPR REP (EL, LEN, SET_NAME, CONCEPT, SPECIAL !POSITION);
03050 JOIN REP1(EL, LEN, SET_NAME, SPLIT CONCEPT) CONS !POSITION;
03060 % RETURNS A DOTTED PAIR OF (NEW_CONCEPT . POSITION), WHERE
03070 NEW_CONCEPT - IS THE CONCEPT WITH THE FIRST OCCURRENCE OF EL REPLACED BY SET_NAME, AND
03080 POSITION - IS THE NUMBER OF SET NAMES IN THE CONCEPT PRECEEDING THE OCCURRENCE OF EL. %
03090
03100
03110 EXPR REP1 (EL, LEN, SET_NAME, L);
03120 % REPLACES THE FIRST OCCURRENCE OF EL WITH SET_NAME IN THE LIST L. %
03130 IF NULL L THEN NIL ELSE
03140 IF L↑LEN = EL THEN SET_NAME CONS L↓LEN
03150 ELSE (IF SET OF CAR L THEN !POSITION ← !POSITION + 1) % THERE IS A SET NAME IN L. %
03160 ALSO CAR L CONS REP1(EL, LEN, SET_NAME, CDR L);
03170
03180
03190 EXPR SRPLACA (S, NEW_S);
03200 BEGIN
03210 RPLACA(S, SUBJ(NEW_S));
03220 RPLACA(S↓2, OBJ(NEW_S));
03230 RPLACA(S↓3, ELEM(NEW_S))
03240 END;
00010 %##############################################################################################################%
00020 %################################## THINK_TIME FUNCTIONS ####################################%
00030 %##############################################################################################################%
00040
00050 EXPR FORM_DEDUCTIONS (ST, INFERENCE_LEVEL);
00060 % DEDUCTIONS ARE STORED WHETHER OR NOT THEY ALREADY EXIST IN THE SYSTEM. %
00070 BEGIN NEW !STLIST, !NEW_STLIST;
00080 SPECIAL !STLIST, !NEW_STLIST;
00090 % 'ALLDEDUC' CONTAINS ALL THE DEDUCTIONS WHICH CAN BE MADE FROM 'ST' IN 'INFERENCE_MAX' LEVELS.
00100 IT IS THE ONLY VARIABLE GLOBAL TO FORM_DEDUCTIONS. %
00110 !STLIST ← ST CONS NIL;
00120 FOR NEW !I←1 TO INFERENCE_LEVEL DO
00130 BEGIN
00140 % THIS IS DONE FOR EACH INFERENCE LEVEL UP TO AND INCLUDING 'INFERENCE_MAX'. %
00150 FOR NEW S IN !STLIST DO
00160 BEGIN NEW SJ, VB, OJ, EL, RULEUSED;
00170 % THIS IS DONE FOR EACH STATEMENT AT THE CURRENT INFERENCE LEVEL. %
00180 SJ ← SUBJ(S); VB ← VERB(S); OJ ← OBJ(S); EL ← ELEMS(S); RULEUSED ← S[5];
00190 FOR NEW R IN RULES(SJ,OJ) DO % TRY TO FORM A NEW DEDUCTION USING EACH APPLICABLE RULE. %
00200 BEGIN NEW D, D4;
00210 IF R = RULEUSED | ¬ D ← DEDUCE(SJ, VB, OJ, EL, R) THEN RETURN NIL;
00220 D4 ← D↑4;
00230 IF D4 NOTIN !ALLDEDUC THEN
00240 BEGIN
00250 STORE_DEDUCTION D4;
00260 !ALLDEDUC ← D4 CONS !ALLDEDUC;
00270 !NEW_STLIST ← D CONS !NEW_STLIST
00280 END
00290 END
00300 END;
00310 !STLIST ← !NEW_STLIST; !NEW_STLIST ← NIL
00320 END
00330 END;
00340
00350
00360 EXPR FORM_CREDIBILITIES (INF);
00370 BEGIN NEW !ALLDEDUC, N;
00380 SPECIAL !ALLDEDUC;
00390 % THE INFORMANT'S 'NEW_STATEMENTS' CONTAINS ALL THE STATEMENTS TO BE DECIDED UPON.
00400 AS STATEMENTS ARE ASSIGNED CREDIBILITIES, THEY ARE TAKEN OFF HIS 'NEW_STATEMENTS'
00410 AND MERGED WITH HIS 'SLIST'. %
00420 N ← 0;
00430 FOR NEW ST IN REVERSE(NEW_STATEMENTS OF INF) DO FORM_CREDIBILITIES1(INF, ST, N ← N+1);
00440 REMPROP(INF, 'NEW_STATEMENTS)
00450 END;
00460
00470
00480 EXPR FORM_CREDIBILITIES1 (INF, ST, N);
00490 % 'ALPHA' IS A FACTOR WEIGHTING THE IMPORTANCE OF DIRECT EVIDENCE, FOUNDATION, AND CONSISTENCY
00500 TO THE INFORMANT'S BELIEVABILITY AS A SOURCE.
00510 'OMEGA' IS A FACTOR WEIGHTING THE RELATIVE IMPORTANCE OF FOUNDATION AND CONSISTENCY.
00520 'RATIO' IS A DYNAMIC FACTOR WHICH VARIES OMEGA DEPENDING ON THE RELATIVE AMOUNTS OF
00530 FOUNDATION AND CONSISTENCY.
00540 %
00550 BEGIN NEW !SUMF, !SUMC, PRELIM, DIREV, FOUND, CONSIS, RATIO, CRED, NEGST, X;
00560 SPECIAL !SUMF, !SUMC;
00570 IF INF EQ 'SELF THEN PRINTSTR("DEDUCTION #" CAT N CAT ": " CAT SAY ST)
00580 ELSE PRINTSTR(INF CAT "'S STATEMENT #" CAT N CAT ": " CAT SAY ST);
00590 ST ← ST @ <NIL>; % THIS IS A PLACE-HOLDER FOR THE 'RULEUSED' TAG PUT ON BY 'INFER' AND 'DEDUCE'. %
00600 NEGST ← NEGATIVE ST;
00610 PRELIM ← PRELIMINARY(INF, ST); PRINC( "PR=" CAT PRELIM);
00620 DIREV ← CALCULATE('DIRECT_EVIDENCE, ST, NEGST); PRINC(" DE=" CAT DIREV);
00630 FOUND ← CALCULATE('FOUNDATION, ST, NEGST); PRINC(" FD=" CAT FOUND); % !SUMF GETS SET HERE. %
00640 CONSIS ← CALCULATE('CONSISTENCY, ST, NEGST); PRINC(" CS=" CAT CONSIS); % !SUMC GETS SET HERE. %
00650 RATIO ← % 'CRAT' CONTROLS WHETHER THE RATIO IS COMPUTED. %
00660 IF !CRAT & !SUMC GREATERP 2*!SUMF THEN % THERE IS TWICE AS MUCH CONSISTENCY AS FOUNDATION. %
00670 IF (X ← 2*!SUMF/!SUMC) LESSP !OMEGA_FACTOR THEN !OMEGA_FACTOR ELSE X
00680 ELSE 1; % OMEGA_FACTOR = (1-OMEGA)/OMEGA. %
00690 PRINC(" RA=" CAT RATIO); % RATIO IS IN THE RANGE: (1-OMEGA)/OMEGA TO 1. %
00700
00710 % THE DIRECT EVIDENCE, FOUNDATION, AND CONSISTENCY ARE ALL NORMALIZED AROUND 0.0; THEY ARE COMPUTED BY:
00720 100 * POSITIVE/(POSITIVE + NEGATIVE) - 50.0
00730 FOR EXAMPLE:
00740 IF THERE WERE EQUAL AMOUNTS (OR NONE) OF POSITIVE AND NEGATIVE EVIDENCE, THEN 'DIREV' WOULD BE 0.0 .
00750 IF THERE WERE ONLY POSITIVE DIRECT_EVIDENCE, THEN 'DIREV' WOULD BE 50.0 .
00760 IF THERE WERE ONLY NEGATIVE DIRECT_EVIDENCE, THEN 'DIREV' WOULD BE -50.0 .
00770 THE FOLLOWING IS THE MAIN FORMULA IN THE PROGRAM FOR COMPUTING CREDIBILITIES:
00780 %
00790
00800 CRED ← PRELIM + !ALPHA*(DIREV + RATIO*!OMEGA*FOUND + (1-RATIO*!OMEGA)*CONSIS);
00810
00820 CRED ← QUANTIZE CRED; TERPRI PRINTSTR(" → CRED= " CAT CRED);
00830 RESTORE_STATEMENT(INF, ST↑4, CRED, SUBJ(ST), OBJ(ST));
00840 IF INF NEQ 'SELF THEN % THIS PREVENTS INFINITE CYCLING. %
00850 BEGIN
00860 FORM_DEDUCTIONS(ST, !INFERENCE_MAX);
00870 FORM_CREDIBILITIES 'SELF
00880 END
00890 END;
00900
00910
00920 EXPR PRELIMINARY (INF, ST);
00930 % CATEGORIZES THE STATEMENT 'ST' AND ARRIVES AT A PRELIMINARY ESTIMATE OF ITS CREDIBILITY
00940 BASED ON THE GENERAL CREDIBILITY OF THE INFORMANT 'INF' IN THOSE CATEGORIES. %
00950 BEGIN NEW CATLIST;
00960 CATLIST ← CATEGORIZE <SUBJ(ST), OBJ(ST)>;
00970 % 'CATGORIZE' RETURNS ALL THE CATEGORIES INTO WHICH RALPH CAN PLACE THE SENTENCE. %
00980 IF NULL CATLIST ← CATEGORIZE <SUBJ(ST), OBJ(ST)> THEN RETURN GLOBALCRED OF INF;
00990 % THE GENERAL CREDIBILITIES OF EACH INFORMANT ARE STORED ON HIS PROPERTY LIST UNDER THE LEGALCRED
01000 INDICATORS. INDF RETRIEVES THE CREDIBILITY INDICATOR FOR THE ASSOCIATED CATEGORY;
01010 FOR EXAMPLE: POLITICS - POLITICSCRED. %
01020 RETURN (FOR NEW CATEGORY IN CATLIST; + INF GET INDF CATEGORY) / LENGTH CATLIST
01030 END;
01040
01050
01060 EXPR CALCULATE (FUNC, ST, NEGST); CALCULATE1(FUNC, FUNC(ST), FUNC(NEGST));
01070
01080
01090 EXPR CALCULATE1 (FUNC, POS, NEG);
01100 PROG2(IF FUNC EQ 'FOUNDATION THEN !SUMF ← POS + NEG ELSE
01110 IF FUNC EQ 'CONSISTENCY THEN !SUMC ← POS + NEG,
01120 IF POS=0.0 & NEG=0.0 THEN 0.0 ELSE 100.0 * POS/(POS + NEG) - 50.0);
01130
01140
01150 EXPR DIRECT_EVIDENCE (ST); DIRECT_EVIDENCE1(ST, SHORTER(SUBJ(ST), OBJ(ST)), NIL);
01160
01170
01180 EXPR DIRECT_EVIDENCE1 (ST, L, S);
01190 IF NULL L THEN 0.0 ELSE
01200 IF (S ← CAR L) SAMEAS ST THEN (CREDF(S) * FREQF(S)) + DIRECT_EVIDENCE1(ST, CDR L, NIL)
01210 ELSE DIRECT_EVIDENCE1(ST, CDR L, NIL);
01220
01230
01240 EXPR FOUNDATION (ST); COMPUTE('INFER, ST);
01250
01260
01270 EXPR CONSISTENCY (ST); COMPUTE('DEDUCE, ST);
01280
01290
01300 EXPR COMPUTE (FUNC, ST);
01310 % LOOKS AT ALL THE STATEMENTS WHICH CAN BE INFERRED (DEDUCED) FROM 'ST', FINDS THE DIRECT EVIDENCE
01320 FOR EACH, AND SUMS THEM TO OBTAIN THE FOUNDATION (CONSISTENCY) WITHIN THE SYSTEM. %
01330 BEGIN NEW !NEW_STLIST, !STLIST, !ALLST, CRED;
01340 SPECIAL !NEW_STLIST, !STLIST, !ALLST;
01350 !STLIST ← ST CONS NIL;
01360 FOR NEW !I←1 TO !INFERENCE_MAX DO
01370 BEGIN
01380 FOR NEW S IN !STLIST DO
01390 BEGIN NEW SJ, VB, OJ, EL, RULEUSED, X;
01400 SJ ← SUBJ(S); VB ← VERB(S); OJ ← OBJ(S); EL ← ELEMS(S); RULEUSED ← S[5];
01410 FOR NEW R IN RULES(SJ,OJ) DO
01420 IF R ≠ RULEUSED & X ← FUNC(SJ, VB, OJ, EL, R) THEN
01430 !NEW_STLIST ← X CONS !NEW_STLIST ALSO !ALLST ← (X↑3) ADDTO !ALLST
01440 END;
01450 !STLIST ← !NEW_STLIST; !NEW_STLIST ← NIL
01460 END;
01470 % NOW 'ALLST' CONTAINS ALL THE STATEMENTS WHICH CAN BE INFERRED (DEDUCED) FROM 'ST'. %
01480 CRED ← 0.0;
01490 FOR NEW S IN !ALLST DO CRED ← CRED + CAR S * DIRECT_EVIDENCE CDR S;
01500 RETURN CRED
01510 END;
01520
01530
01540 EXPR ADDTO (X, L);
01550 % THIS ELIMINATES DUPLICATION BY CHECKING IF 'X' IS ALREADY A MEMBER OF THE LIST 'L',
01560 AND KEEPING A COUNTER OF THE NUMBER OF TIMES IT IS ADDED TO 'L'. %
01570 IF NULL L THEN <1 CONS X> ELSE
01580 IF CDAR L = X THEN (ADD1 CAAR L CONS CDAR L) CONS CDR L
01590 ELSE CAR L CONS X ADDTO CDR L;
01600
01610
01620 EXPR RE_EVALUATE (INF);
01630 % AT THE END OF EVERY CREDIBILITY ASSIGNMENT PROCESS,
01640 RALPH RE_EVALUATES THE CREDIBILITY OF BOTH THE CURRENT INFORMANT AND ITSELF AS SOURCES. %
01650 BEGIN NEW GLOBALCRED;
01660 TPRINTSTR("RE-EVALUATING " CAT INF);
01670 % ZERO THE ACCUMULATORS. %
01680 FOR NEW CATEGORY IN !LEGALCAT DO
01690 BEGIN
01700 PUTPROP(CATEGORY, 0.0, 'ACCUMVAL);
01710 PUTPROP(CATEGORY, 0, 'ACCUMNUM)
01720 END;
01730 % SUM THE CREDIBILITIES OF THE STATEMENTS. %
01740 FOR NEW S IN STATEMENTS INF DO
01750 FOR NEW CATEGORY IN CATEGORIZE <SUBJ(S), OBJ(S)> DO
01760 BEGIN
01770 ADDPROP(CATEGORY, CREDF(S) * FREQF(S), 'PLUS, 'ACCUMVAL);
01780 ADDPROP(CATEGORY, FREQF(S), 'PLUS, 'ACCUMNUM)
01790 END;
01800 % DIVIDE TO OBTAIN AVERAGES. %
01810 FOR NEW CATEGORY IN !LEGALCAT DO
01820 IF ACCUMVAL OF CATEGORY = 0.0 THEN NIL
01830 ELSE PUTPROP(INF, (ACCUMVAL OF CATEGORY) / (ACCUMNUM OF CATEGORY), INDF CATEGORY);
01840 % QUANTIZE THE INDIVIDUAL CREDIBILITIES. %
01850 FOR NEW CREDIND IN !LEGALCRED DO PUTPROP(INF, QUANTIZE(INF GET CREDIND), CREDIND);
01860 % COMPUTE THE GLOBAL CREDIBILITY AS THE AVERAGE OF THE INDIVIDUAL CREDIBILITIES. %
01870 GLOBALCRED ← 0.0;
01880 FOR NEW CREDIND IN !LEGALCRED DO GLOBALCRED ← GLOBALCRED + (INF GET CREDIND);
01890 GLOBALCRED ← QUANTIZE(GLOBALCRED / LENGTH !LEGALCRED);
01900 PUTPROP(INF, GLOBALCRED, 'GLOBALCRED)
01910 END;
01920
01930
01940 EXPR DEDUCE (S, V, O, E, R);
01950 % THE RULES USED IN FORMING DEDUCTIONS AND CONCLUSIONS ARE:
01960 (P, P => Q) => Q
01970 (NOT Q, P => Q) => NOT P
01980 (Q, P => Q) => POSSIBLY P (IF Q DOES NOT CONTAIN 'NOT').
01990 %
02000 BEGIN NEW P, Q;
02010 P ← R[1]; Q ← R[2]; % THE LEFT- AND RIGHT-HALVES OF THE RULE. %
02020 IF O EQ OBJ(P) THEN
02030 IF V SIMILARTO VERB(P) THEN RETURN <S, VERB(Q), OBJ(Q), <E, ELEMO(Q)>, R>
02040 ELSE NIL ELSE
02050 IF O EQ OBJ(Q) THEN
02060 IF V NEGATIVEOF VERB(Q) THEN RETURN <S, NEGATE VERB(P), OBJ(P), <E, ELEMO(P)>, R> ELSE
02070 % THE VERBS ARE SIMILAR TO EACH OTHER. %
02080 IF 'NOT NOTIN V THEN RETURN <S, POSS VERB(P), OBJ(P), <E, ELEMO(P)>, R>
02090 ELSE NIL
02100 ELSE NIL
02110 END;
02120
02130
02140 EXPR INFER (S, V, O, E, R);
02150 % 'INFER' IS THE EXACT OPPOSITE OF 'DEDUCE'; INSTEAD OF USING THE RULE 'R' TO FORM A DEDUCTION,
02160 IT IS USED TO BACKWARD CHAIN TO AN EARLIER STATEMENT.
02170 (Q, P => Q) => INFER P
02180 (NOT P, P => Q) => INFER NOT Q
02190 (POSSIBLY P, P => Q) => INFER Q (IF Q DOES NOT CONTAIN 'NOT').
02200 %
02210 BEGIN NEW P, Q;
02220 P ← R[1]; Q ← R[2]; % THE LEFT- AND RIGHT-HALVES OF THE RULE. %
02230 IF O EQ OBJ(Q) THEN
02240 IF V SIMILARTO VERB(Q) THEN RETURN <S, VERB(P), OBJ(P), <E, ELEMO(P)>, R>
02250 ELSE NIL ELSE
02260 IF O EQ OBJ(P) THEN
02270 IF V NEGATIVEOF VERB(P) THEN RETURN <S, NEGATE VERB(Q), OBJ(Q), <E, ELEMO(Q)>, R> ELSE
02280 % THE VERBS ARE SIMILAR TO EACH OTHER. %
02290 IF 'POSSIBLY ε V & 'NOT NOTIN VERB(Q) THEN RETURN <S, VERB(Q), OBJ(Q), <E, ELEMO(Q)>, R>
02300 ELSE NIL
02310 ELSE NIL
02320 END;
02330
02340
02350 EXPR QUANTIZE (N);
02360 IF N GREATERP 80.0 THEN 90.0 ELSE
02370 IF N GREATERP 65.0 THEN 70.0 ELSE
02380 IF N GREATERP 49.9 THEN 60.0 ELSE
02390 IF N GREATERP 35.0 THEN 40.0 ELSE
02400 IF N GREATERP 20.0 THEN 30.0 ELSE 10.0;
02410
02420
02430 EXPR STRENGTH (CRED);
02440 IF CRED = 90.0 THEN 'STRONGLY?-BELIEVE ELSE
02450 IF CRED = 70.0 THEN 'MODERATELY?-BELIEVE ELSE
02460 IF CRED = 60.0 THEN 'WEAKLY?-BELIEVE ELSE
02470 IF CRED = 40.0 THEN 'WEAKLY?-DISBELIEVE ELSE
02480 IF CRED = 30.0 THEN 'MODERATELY?-DISBELIEVE ELSE
02490 IF CRED = 10.0 THEN 'STRONGLY?-DISBELIEVE ELSE 'HUH??;
02500
02510
02520 EXPR NUMERICAL_VALUE (CRED); IF NUMBERP CRED THEN CRED ELSE GET(CRED,'NUMERICAL_VALUE);
02530
02540
02550 FOR NEW I IN '( (STRONGLY?-BELIEVE . 90.0)
02560 (MODERATELY?-BELIEVE . 70.0)
02570 (WEAKLY?-BELIEVE . 60.0)
02580 (WEAKLY?-DISBELIEVE . 40.0)
02590 (MODERATELY?-DISBELIEVE . 30.0)
02600 (STRONGLY?-DISBELIEVE . 10.0) ) DO PUTPROP(CAR I, CDR I, 'NUMERICAL_VALUE);
00010 %##############################################################################################################%
00020 %#################################### AUXILIARY ROUTINES ####################################%
00030 %##############################################################################################################%
00040
00050 EXPR ADDPROP (A, PROP, FUNC, IND); PUTPROP(A, EVAL <FUNC, <'QUOTE, PROP>, <'QUOTE, A GET IND>>, IND);
00060
00070
00080 EXPR JOIN (L); READLIST(EXPLODEC CAR L @ JOIN1 CDR L);
00090
00100
00110 EXPR JOIN1 (L); IF NULL L THEN NIL ELSE DASH CONS EXPLODEC CAR L @ JOIN1 CDR L;
00120
00130
00140 EXPR SPLIT (A);
00150 BEGIN NEW L, S;
00160 FOR NEW I IN REVERSE EXPLODEC A DO
00170 IF I EQ DASH THEN S ← READLIST L CONS S ALSO L ← NIL ELSE L ← I CONS L;
00180 RETURN READLIST L CONS S
00190 END;
00200
00210
00220 EXPR SAMEAS (S1, S2); SUBJ(S1) EQ SUBJ(S2) & OBJ(S1) EQ OBJ(S2) & VERB(S1) SIMILARTO VERB(S2);
00230 % 'SAMEAS' MEANS: THE SUBJECTS AND OBJECTS ARE THE SAME AND THE VERBS ARE SIMILAR. %
00240
00250
00260 EXPR OPPOF (S1, S2); SUBJ(S1) EQ SUBJ(S2) & OBJ(S1) EQ OBJ(S2) & VERB(S1) NEGATIVEOF VERB(S2);
00270
00280
00290 EXPR SIMILARTO (VB1, VB2); SIMILARTO1('NOT ε VB1, 'NOT ε VB2);
00300 % IN ORDER FOR TWO VERBS TO BE SIMILAR, EITHER 'NOT' MUST BE IN BOTH VERB FIELDS, OR IT MUST BE IN NEITHER. %
00310
00320
00330 EXPR SIMILARTO1 (U, V); U & V | ¬U & ¬V;
00340
00350
00360 EXPR NEGATIVEOF (VB1, VB2); NEGATIVEOF1('NOT ε VB1, 'NOT ε VB2);
00370 % THIS IS THE SAME AS "NOT SIMILAR TO". %
00380
00390
00400 EXPR NEGATIVEOF1 (U, V); (U | V) & ¬(U & V);
00410
00420
00430 % SENTENCES ARE IN THE FORM: (SUBJECT (VERB) OBJECT (SET ELEMENTS) CREDIBILITY FREQUENCY INFORMANT). %
00440
00450
00460 EXPR ELEMS(SENT); SENT[4,1]; % SET ELEMENTS FOR THE SUBJECT FIELD. %
00470
00480
00490 EXPR ELEMO (SENT); SENT[4,2]; % SET ELEMENTS FOR THE OBJECT FIELD. %
00500
00510
00520 EXPR CREDF (SENT); SENT[5]; % THE CREDIBILITY OF THE SENTENCE. %
00530
00540
00550 EXPR FREQF (SENT); SENT[6]; % THE FREQUENCY OF THE SENTENCE. %
00560
00570
00580 EXPR WHO (SENT); SENT[7]; % THE INFORMANT WHO SAID THE SENTENCE. %
00590
00600
00610 EXPR ISTRUE (ANSLIST); NULL ANSLIST | ISTRUE1(CAR ANSLIST) & ISTRUE(CDR ANSLIST);
00620
00630
00640 EXPR ISTRUE1 (ANS); (SUBSTR(ANS,1,5) SEQ "YES, ") | (SUBSTR(ANS,1,8) SEQ "NO, BUT ");
00650
00660
00670 EXPR ISFALSE (ANSLIST); NULL ANSLIST | ISFALSE1(CAR ANSLIST) & ISFALSE(CDR ANSLIST);
00680
00690
00700 EXPR ISFALSE1 (ANS); (SUBSTR(ANS,1,4) SEQ "NO, ") & ¬(SUBSTR(ANS,1,8) SEQ "NO, BUT ");
00710
00720
00730 EXPR NEGATIVE (ST); SUBJ(ST) CONS NEGATE VERB(ST) CONS ST↓2;
00740
00750
00760 EXPR NEGATE (V); IF 'NOT ε V THEN REMOVE_ELEMENT('NOT, V) ELSE CAR V CONS NEGATE1(CDR V);
00770 % V IS OF THE FORM: (IS A) OR (IS NOT A). %
00780
00790
00800 EXPR NEGATE1 (RESTV);
00810 IF RESTV & GET(CAR RESTV,'MODAL) THEN CAR RESTV CONS 'NOT CONS CDR RESTV ELSE 'NOT CONS RESTV;
00820 % THIS INSURES THAT THE 'NOT' WILL FOLLOW ANY MODALS IN THE VERB. %
00830
00840
00850 EXPR PROB (VB); WEAKEN(VB, 'PROBABLY);
00860
00870
00880 EXPR POSS (VB); WEAKEN(VB, 'POSSIBLY);
00890
00900
00910 EXPR WEAKEN (VB, MODAL);
00920 BEGIN NEW WVB, FLAG;
00930 % IF THE VERB ALREADY CONTAINED A MODAL, THEN THAT MODAL MUST BE 'PROBABLY' OR 'POSSIBLY';
00940 IN EITHER CASE IT IS WEAKENED TO 'POSSIBLY'. %
00950 WVB ← FOR NEW I IN VB COLLECT IF GET(I,'MODAL) THEN FLAG ← '(POSSIBLY) ELSE <I>;
00960 IF FLAG THEN RETURN WVB
00970 % OTHERWISE THE VERB CONTAINED NO MODALS, SO INSERT THE SPECIFIED MODAL. %
00980 ELSE RETURN CAR VB CONS MODAL CONS CDR VB
00990 END;
01000
01010
01020 EXPR PHRASE (NEXT);
01030 IF GET(!NEXTCHAR,'ENDER) | !NEXTCHAR EQ COMMA THEN <NEXT> ELSE NEXT CONS PHRASE SCANNER !NEXTCHAR;
01040
01050
01060 EXPR REPLACE (CONCEPT, NEW_CONCEPT, S, JEL, POSITION);
01070 IF SUBJ(S) EQ CONCEPT THEN % IT IS THE SUBJECT THAT IS TO BE REPLACED. %
01080 NEW_CONCEPT CONS VERB(S) CONS OBJ(S) CONS
01090 <ELEMS(S)↑POSITION @ JEL CONS ELEMS(S)↓POSITION, ELEMO(S)> CONS S↓4 ELSE
01100 IF OBJ(S) EQ CONCEPT THEN % THE OBJECT IS TO BE REPLACED. %
01110 SUBJ(S) CONS VERB(S) CONS NEW_CONCEPT CONS
01120 <ELEMS(S), ELEMO(S)↑POSITION @ JEL CONS ELEMO(S)↓POSITION> CONS S↓4
01130 ELSE S;
01140
01150
01160 EXPR SAY (S);
01170 % ASSUMES S IS IN FORM (SUBJECT (VERB) OBJECT (SET ELEMENTS) ... ) %
01180 BEGIN NEW ELEMENTS, L;
01190 ELEMENTS ← ELEMS(S) @ ELEMO(S); % ALL THE SET ELEMENTS REPLACED BY SET NAMES ARE STORED AT THE END
01200 OF THE SENTENCE IN A 1-1 CORRESPONDENCE WITH THE OCCURRENCES OF
01210 THE SET NAMES. %
01220 L ← FOR NEW I IN SPLIT SUBJ(S) @ VERB(S) @ SPLIT OBJ(S) COLLECT
01230 IF SET OF I THEN % THE ENTRY IS A SET NAME. %
01240 SPLIT CAR ELEMENTS DO2 ELEMENTS ← CDR ELEMENTS
01250 ELSE <I>;
01260 RETURN FOR NEW I IN L; CAT I CAT BLANK
01270 END;
01280
01290
01300 EXPR STATEMENTS (INF); GETLIST(INF, 'STATEMENTS, NIL);
01310
01320
01330 EXPR GETLIST (INF, IND, L);
01340 (FOR NEW CONCEPT IN CONCEPT_LIST OF 'PERSONS DO
01350 FOR NEW I IN CONCEPT GET IND DO
01360 IF WHO(I) EQ INF & I NOTIN L THEN L ← I CONS L)
01370 PROG2 L;
01380
01390
01400 EXPR SHORTER (SJ, OJ);
01410 IF SLENGTH OF SJ LESSP SLENGTH OF OJ THEN GET(SJ,'STATEMENTS) ELSE GET(OJ,'STATEMENTS);
01420
01430
01440 EXPR RULES (SJ, OJ); RULES OF SJ @ RULES OF OJ;
01450
01460
01470 EXPR NEW_OLD (INF, NEW_SLIST, CONCEPT);
01480 NEW_SLIST @ FOR NEW I IN GET(CONCEPT,'STATEMENTS) COLLECT IF WHO(I) EQ INF THEN <I>;
01490
01500
01510 EXPR CATEGORIZE (CONCEPT_LIST);
01520 BEGIN NEW L;
01530 FOR NEW CONCEPT IN CONCEPT_LIST DO
01540 FOR NEW CATEGORY IN !LEGALCAT DO
01550 IF CONCEPT GET CATEGORY THEN L ← CATEGORY XCLCONS L;
01560 RETURN L
01570 END;
01580
01590
01600 EXPR INDF (CATEGORY); CREDINDICATOR OF CATEGORY;
01610 % THIS RETRIEVES THE CREDIBILITY INDICATOR ASSOCIATED WITH EACH CATEGORY; EXAMPLE: POLITICS - POLITICSCRED. %
01620
01630
01640 EXPR CONCEPTS (R); <OBJ(R[1]), OBJ(R[2])>;
01650
01660
01670 EXPR COMBINE (A, L); A CONS REMOVE_ELEMENT(A, L); % THIS ROTATES 'A' TO THE HEAD OF 'L'. %
01680
01690
01700 EXPR COMBINEL (L, LL); IF L ε LL THEN LL ELSE COMBINESORT(L, LENGTH L, LL);
01710
01720
01730 EXPR XCLCONS (X, L); IF X ε L THEN L ELSE X CONS L; % 'EXCLUSIVE' CONS %
01740
01750
01760 EXPR COMBINESORT (L, LEN, LL);
01770 % DOES A MERGE TO INSURE THAT LL REMAINS SORTED (LONGEST MEMBERS FIRST). %
01780 IF NULL LL THEN <L> ELSE
01790 IF LEN LESSP LENGTH CAR LL THEN CAR LL CONS COMBINESORT(L, LEN, CDR LL)
01800 ELSE L CONS LL;
01810
01820
01830 EXPR REMOVE_ELEMENT (S, L);
01840 % RETURNS THE LIST 'L' WITH THE FIRST OCCURRENCE OF THE S-EXPRESSION 'S' REMOVED. %
01850 IF NULL L THEN NIL ELSE
01860 IF S = CAR L THEN CDR L
01870 ELSE CAR L CONS REMOVE_ELEMENT(S, CDR L);
01880
01890
01900 EXPR LAST_ATOM (L); CAR LAST L; % 'LAST' RETURNS A LIST OF THE LAST ELEMENT IN L. %
01910
01920
01930 EXPR DO2 (A, B); A;
01940
01950
01960 EXPR TPRINTSTR (S); TERPRI PRINTSTR S; % SKIPS A LINE AFTER PRINTING. %
01970
01980
01990 EXPR PRINTSTRING (S);
02000 % PRINTSTRING TRIES NOT TO BREAK UP WORDS ON LINE BOUNDARIES. %
02010 BEGIN NEW N;
02020 N ← 0;
02030 FOR NEW I IN EXPLODEC S DO
02040 IF N ≥ 58 & I EQ BLANK THEN TERPRI NIL ALSO N ← 0 ELSE PRINC I ALSO N ← N+1;
02050 TERPRI NIL
02060 END;
02070
02080
02090 EXPR SORT (L); SORT1(L, NIL);
02100 % L IS A LIST OF LISTS; 'SORT' ORDERS L ACCORDING TO LENGTH, LONGEST ELEMENTS FIRST. %
02110
02120
02130 EXPR SORT1 (L, V); FOR NEW I IN L DO V ← SORT2(I, LENGTH I, V);
02140
02150
02160 EXPR SORT2 (NEXT, LEN, L);
02170 IF NULL L THEN <NEXT> ELSE
02180 IF LENGTH CAR L GREATERP LEN THEN CAR L CONS SORT2(NEXT, LEN, CDR L)
02190 ELSE NEXT CONS L;
02200
02210
02220 EXPR TRUNCATE (L, N); IF NULL L THEN NIL ELSE (CAR L)↑N CONS TRUNCATE(CDR L, N);
02230
02240
02250 % THE FOLLOWING ARE SOME FUNCTIONS TO TIGHTEN UP THE DATA BASE. %
02260
02270 EXPR DATA_CONDENSE ();
02280 BEGIN
02290 TPRINTSTR "CONDENSING DATA BASE.";
02300 FOR NEW CONCEPT IN CONCEPT_LIST OF 'PERSONS DO
02310 PUTPROP(CONCEPT, QUANTIZE_ALL(CONDENSE(GET(CONCEPT,'STATEMENTS), NIL), NIL), 'STATEMENTS);
02320 RETURN 'FINISHED
02330 END;
02340
02350
02360 EXPR CONDENSE (REST, NEW_LIST);
02370 IF NULL REST THEN NEW_LIST ELSE CONDENSE1(CAR REST, CDR REST, NEW_LIST);
02380
02390
02400 EXPR CONDENSE1 (FIRST, REST, NEW_LIST);
02410 % ALL THE STATEMENTS IN 'NEW_LIST' ARE GOOD. %
02420 IF FIRST INSIDE NEW_LIST THEN CONDENSE(REST, MERGE(FIRST, NEW_LIST, WHO(FIRST))) ELSE
02430 IF TEST VERB(FIRST) THEN CONDENSE(REST, FIRST CONS NEW_LIST) ELSE
02440 IF FIRST INSIDE REST THEN CONDENSE(MERGE(FIRST, REST, WHO(FIRST)), NEW_LIST)
02450 ELSE CONDENSE(REST, FIRST CONS NEW_LIST);
02460
02470
02480 EXPR MERGE (X, L, WHOX);
02490 (FOR NEW I IN L DO NIL UNTIL WHO(I) EQ WHOX & I SAMEAS X &
02500 L ← <SUBJ(I), VERB(I), OBJ(I), ELEM(I), (CREDF(I) * FREQF(I) + CREDF(X) * FREQF(X)) / (FREQF(I) + FREQF(X)),
02510 FREQF(I) + FREQF(X), WHO(I)> CONS REMOVE_ELEMENT(I, L))
02520 PROG2 L;
02530
02540
02550 EXPR QUANTIZE_ALL (L, X);
02560 FOR NEW I IN L DO X ← (I↑4 @ QUANTIZE CREDF(I) CONS I↓5) CONS X;
02570
02580
02590 EXPR TEST (VB); 'PROBABLY ε VB | 'POSSIBLY ε VB | ('A NOTIN VB & 'IS ε VB);
02600
02610
02620 EXPR INSIDE (X, L); INSIDE1(X, L, WHO(X), NIL);
02630
02640
02650 EXPR INSIDE1 (X, L, WHOX, I); (FOR I IN L DO NIL UNTIL WHO(I) EQ WHOX & I SAMEAS X) PROG2 I;
00010 %##############################################################################################################%
00020 %###################################### STORE ROUTINES ######################################%
00030 %##############################################################################################################%
00040
00050 EXPR STORE_PERSON (INF, CRED);
00060 % THIS INITIALIZES A PERSON'S CREDIBILITY VALUES THE FIRST TIME HE TALKS TO RALPH. %
00070 BEGIN
00080 ADDPROP('PERSONS, INF, 'CONS, 'PLIST);
00090 PUTPROP(INF, CRED, 'GLOBALCRED);
00100 FOR NEW CREDIND IN !LEGALCRED DO PUTPROP(INF, CRED, CREDIND)
00110 END;
00120
00130
00140 EXPR STORE_STATEMENT (INF, ST);
00150 % THIS STORES 'TALK_TIME' SENTENCES. %
00160 BEGIN
00170 ADDPROP(INF, ST, 'CONS, 'NEW_STATEMENTS);
00180 STORE_CONCEPT SUBJ(ST);
00190 STORE_CONCEPT OBJ(ST);
00200 RETURN TPRINTSTR " STATEMENT OK"
00210 END;
00220
00230
00240 EXPR RESTORE_STATEMENT (INF, ST, CRED, SJ, OJ);
00250 % RESTORES SENTENCES AFTER A CREDIBILITY VALUE HAS BEEN ASSIGNED BY 'THINK_TIME'. %
00260 BEGIN NEW S;
00270 FOR S IN SHORTER(SJ,OJ) DO NIL UNTIL WHO(S) EQ INF & S↑4 = ST & RPLACD(S↓3, <CRED, FREQF(S) + 1, INF>);
00280 IF S THEN RETURN NIL; % THE STATEMENT ALREADY EXISTED. %
00290 ST ← ST @ <CRED, 1, INF>; % OTHERWISE ADD THE CREDIBILITY, SOURCE, AND A FREQUENCY OF 1. %
00300 ADDPROP(SJ, ST, 'CONS, 'STATEMENTS); % STORE THE SENTENCE UNDER THE SUBJECT. %
00310 ADDPROP(SJ, 1, 'PLUS, 'SLENGTH); % UP THE STATEMENT COUNT. %
00320 ADDPROP(OJ, ST, 'CONS, 'STATEMENTS); % AND UNDER THE OBJECT. %
00330 ADDPROP(OJ, 1, 'PLUS, 'SLENGTH) % UP THE STATEMENT COUNT. %
00340 END;
00350
00360
00370 EXPR STORE_RULE (INF, NEW_R);
00380 BEGIN NEW CRED, N, R, OBJLH, OBJRH;
00390 % CREDIBILITIES ARE ASSIGNED TO RULES AS FOLLOWS:
00400 THE RULES ARE CATEGORIZED, AND THEN THE AVERAGE OF THE CREDIBILITIES OF THE INFORMANT
00410 IN THOSE CATEGORIES IS TAKEN TO BE THE CREDIBILITY OF THE RULE. %
00420 CRED ← 0.0; N ← 0;
00430 FOR NEW CATEGORY IN CATEGORIZE CONCEPTS NEW_R FOR N←1 TO 1000 DO CRED ← CRED + (INF GET INDF CATEGORY);
00440 % IF THE RULE CANNOT BE CATEGORIZED, ITS CREDIBILITY IS TAKEN TO BE THE INFORMANT'S GLOGAL CREDIBILITY. %
00450 IF N=0 THEN CRED ← GLOBALCRED OF INF ELSE CRED ← QUANTIZE(CRED/N);
00460 FOR R IN RULES OF OBJ(NEW_R[1]) DO NIL UNTIL R[5] EQ INF & R↑2 = NEW_R;
00470 IF R THEN RPLACD(CDR R, <CRED, R[4]+1, INF>) % THE RULE ALREADY EXISTED. %
00480 ELSE BEGIN
00490 R ← NEW_R @ <CRED, 1, INF>;
00500 ADDPROP(OBJ(R[1]), R, 'CONS, 'RULES);
00510 ADDPROP(OBJ(R[2]), R, 'CONS, 'RULES)
00520 END;
00530 STORE_CONCEPT OBJLH ← OBJ(R[1]);
00540 STORE_CONCEPT OBJRH ← OBJ(R[2]);
00550 STORE_INTERIM_DEDUCTIONS(R, OBJLH, OBJRH);
00560 TPRINTSTR " RULE OK";
00570 RETURN T
00580 END;
00590
00600
00610 EXPR STORE_INTERIM_DEDUCTIONS (R, OBJLH, OBJRH);
00620 % THIS FORMS DEDUCTIONS EVERY TIME A NEW RULE IS ENTERED. %
00630 BEGIN NEW !ALLDEDUC, STLIST; SPECIAL !ALLDEDUC;
00640 FOR NEW S IN NEW_STATEMENTS OF 'SELF @ GET(OBJLH,'STATEMENTS) @ GET(OBJRH,'STATEMENTS) DO
00650 STLIST ← S↑4 CONS STLIST;
00660 !ALLDEDUC ← STLIST;
00670 FOR NEW S IN STLIST DO
00680 BEGIN NEW D, D4;
00690 D ← DEDUCE(SUBJ(S), VERB(S), OBJ(S), ELEMS(S), R);
00700 IF D & (D4 ← D↑4) NOTIN !ALLDEDUC THEN
00710 BEGIN
00720 STORE_DEDUCTION D4;
00730 !ALLDEDUC ← D4 CONS !ALLDEDUC;
00740 FORM_DEDUCTIONS(D, !INFERENCE_MAX - 1) % THIS USES !ALLDEDUC (?) %
00750 END
00760 END
00770 END;
00780
00790
00800 EXPR STORE_QUESTION (INF, ST); STORE_IT(INF, ST, 'QUESTIONS);
00810
00820
00830 EXPR STORE_CONCLUSION (INF, ST); STORE_IT(INF, ST, 'CONCLUSIONS);
00840
00850
00860 EXPR STORE_IT (INF, ST, IND);
00870 BEGIN NEW S;
00880 FOR S IN GET(SUBJ(ST), IND) DO NIL UNTIL S[6] EQ INF & S↑4 = ST & RPLACA(S↓4, S[5]+1);
00890 IF ¬S THEN % THE SENTENCE DID NOT ALREADY EXIST. %
00900 BEGIN
00910 ST ← ST @ <1,INF>; % THE FREQUENCY (5) AND INFORMANT (6). %
00920 ADDPROP(SUBJ(ST), ST, 'CONS, IND);
00930 ADDPROP(OBJ(ST), ST, 'CONS, IND)
00940 END
00950 END;
00960
00970
00980 EXPR STORE_CATEGORY (CONCEPT, CATEGORY);
00990 % WHEN A WORD IS CATEGORIZED,
01000 (1) THE CATEGORY IS PUT ON THE WORD'S PROPERTY LIST AS AN INDICATOR,
01010 (2) THE WORD IS ADDED TO A LIST OF THE OTHER WORDS IN THE CATEGORY (WHICH IS STORED
01020 ON THE CATEGORY'S PROPERTY LIST), AND
01030 (3) THE CONCEPT IS MARKED AS BEING CATEGORIZED. %
01040 BEGIN
01050 PUTPROP(CONCEPT, T, CATEGORY); % (1) %
01060 ADDPROP(CATEGORY, CONCEPT, 'XCLCONS, 'CATEGORY); % (2) %
01070 PUTPROP(CONCEPT, T, 'CATEGORIZED) % (3) %
01080 END;
01090
01100
01110 EXPR STORE_DEDUCTION (L); ADDPROP('SELF, L, 'CONS, 'NEW_STATEMENTS);
01120 % DEDUCTIONS ARE PUT ON A 'SELF' LIST, RATHER THAN AN INFORMANT LIST. %
01130
01140
01150 EXPR STORE_CONCEPT (CONCEPT);
01160 IF CONCEPT ε CONCEPT_LIST OF 'PERSONS THEN ADDPROP('PERSONS, CONCEPT, 'COMBINE, 'CONCEPT_LIST)
01170 ELSE BEGIN
01180 ADDPROP('PERSONS, CONCEPT, 'CONS, 'CONCEPT_LIST);
01190 PUTPROP(CONCEPT, 0, 'SLENGTH) % THE STATEMENT LENGTH OF ALL CONCEPTS IS INITIALIZED TO ZERO. %
01200 END;
01210
01220
01230 EXPR STORE_VARIABLE (INF, VARNAME, VARLIST);
01240 BEGIN
01250 STORE_CONCEPT VARNAME;
01260 FOR NEW I IN VARLIST DO STORE_CONCEPT I;
01270 PUTPROP(VARNAME, VARLIST, 'VARIABLE);
01280 ADDPROP(INF, VARNAME, 'XCLCONS, 'VARIABLES)
01290 END;
01300
01310
01320 EXPR STORE_SET (INF, SET_NAME, SET_LIST);
01330 BEGIN
01340 PUTPROP(SET_NAME, SET_LIST, 'SET); % SETS ARE STORED UNDER THE SET NAME. %
01350 ADDPROP(INF, SET_NAME, 'XCLCONS, 'SETS) % ADD THE SET NAME TO THE INFORMANT'S SETS. %
01360 END;
01370
01380
01390 FEXPR RESTORE_DATA (L);
01400 % THE ARGUMENTS TO 'RESTORE_DATA' ARE EITHER
01410 (1) A DEVICE AND FILENAME, E.G. DSK: DATA,
01420 (2) A FILENAME, E.G. DATA (IN WHICH CASE THE DSK: IS ASSUMED),
01430 (3) NOTHING (IN WHICH CASE DSK: DATA ARE ASSUMED FOR THE DEVICE AND FILE). %
01440 BEGIN NEW !PLIST, X, CONCEPT_LIST;
01450 SPECIAL !PLIST;
01460 IF L THEN % OPEN THE DATA FILE. %
01470 IF CDR L THEN EVAL('INPUT CONS L) ELSE EVAL <'INPUT, 'DSK:, CAR L>
01480 ELSE INPUT(DSK:, DATA);
01490 INC(T,NIL);
01500 READ(); DO NIL UNTIL READCH() EQ LF; % DISCARD THE HEADER. %
01510 CONCEPT_LIST ← WHILE (X ← READ()) NEQ '!THE COLLECT PUTPROP(X, 0, 'SLENGTH) PROG2 <X>;
01520 PUTPROP('PERSONS, CONCEPT_LIST, 'CONCEPT_LIST);
01530 % TAKE CARE OF ALL THE OPERATIONS WHICH HAVE TO BE DONE FOR EACH INFORMANT. %
01540 WHILE X EQ '!THE DO X ← RESTORE_DATA1();
01550 FOR NEW CATEGORY IN LEGALCATLIST OF 'PERSONS DO
01560 BEGIN
01570 READ();
01580 FOR NEW CONCEPT IN READ() DO STORE_CATEGORY(CONCEPT, CATEGORY)
01590 END;
01600 PUTPROP('PERSONS, REVERSE !PLIST, 'PLIST);
01610 % RESTORE THE CONCEPT_LIST TO ITS ORIGINAL FORM. (IT WAS CHANGED BY THE 'STORE' OPERATIONS ABOVE.) %
01620 PUTPROP('PERSONS, CONCEPT_LIST, 'CONCEPT_LIST);
01630 INC(NIL,T);
01640 RETURN 'FINISHED
01650 END;
01660
01670
01680 EXPR RESTORE_DATA1 ();
01690 % THIS IS DONE FOR EACH INFORMANT. 'PLIST' IS GLOBAL TO RESTORE_DATA1. %
01700 BEGIN NEW X, INF;
01710 READ(); READ(); READ(); INF ← READ(); % GET THE INFORMANT'S NAME. %
01720 !PLIST ← INF CONS !PLIST;
01730 READ(); % GET RID OF 'STATEMENTS'. %
01740 FOR NEW IND IN MAIN_INDICATORS OF 'PERSONS @ '(AASLIST AALIST) DO
01750 WHILE ¬ ATOM X ← READ() DO RESTORE_PROPERTY(INF, IND, X);
01760 FOR NEW !I IN READ() DO STORE_VARIABLE(INF, READ(), READ()); % READ THE VARIABLES. %
01770 READ(); % GET RID OF 'SETS'. %
01780 FOR NEW !I IN READ() DO STORE_SET(INF, READ(), READ()); % READ THE SETS. %
01790 READ(); % GET RID OF 'CREDIBILITIES'. %
01800 FOR NEW IND IN LEGALCREDLIST OF 'PERSONS @ <'GLOBALCRED> DO
01810 READ() PROG2 PUTPROP(INF, NUMERICAL_VALUE READ(), IND);
01820 RETURN READ()
01830 END;
01840
01850
01860 EXPR RESTORE_PROPERTY (INF, IND, X);
01870 IF IND ε '(AASLIST AALIST) THEN ADDPROP(INF, X, 'CONS, IND) ELSE
01880 BEGIN NEW CON1, CON2;
01890 IF IND EQ 'RULES THEN CON1 ← OBJ(X[1]) ALSO CON2 ← OBJ(X[2])
01895 ELSE CON1 ← SUBJ(X) ALSO CON2 ← OBJ(X);
01900 IF IND EQ 'STATEMENTS THEN X ← X↑4 @ NUMERICAL_VALUE(CREDF(X)) CONS X↓5;
01910 FOR NEW C IN <CON1, CON2> DO
01920 BEGIN
01930 ADDPROP(C, X, 'CONS, IND);
01940 IF IND EQ 'STATEMENTS THEN ADDPROP(C, 1, 'PLUS, 'SLENGTH)
01950 END
01960 END;
00010 %##############################################################################################################%
00020 %###################################### PRINT ROUTINES ######################################%
00030 %##############################################################################################################%
00040
00050 EXPR PCONCEPTS ();
00060 BEGIN
00070 PRINTSTR "ALL THE CONCEPTS IN MEMORY -- FROM THE NEW_EST TO THE OLDEST: ";
00080 TERPRI FOR NEW I IN CONCEPT_LIST OF 'PERSONS DO PRINT I
00090 END;
00100
00110
00120 FEXPR PSAYS (INF);
00130 BEGIN
00140 INF ← CAR INF;
00150 TPRINTSTR("!THE DATA LISTS OF " CAT INF);
00160 EVAL <'PSTATEMENTS, INF>;
00170 EVAL <'PRULES, INF>;
00180 EVAL <'PCONCLUSIONS, INF>;
00190 EVAL <'PQUESTIONS, INF>
00200 END;
00210
00220
00230 FEXPR PSTATEMENTS (INF); PLISTF(CAR INF, 'STATEMENTS, 'STATEMENTS);
00240
00250
00260 FEXPR PRULES (INF); PLISTF(CAR INF, 'RULES, 'RULES);
00270
00280
00290 FEXPR PCONCLUSIONS (INF); PLISTF(CAR INF, 'CONCLUSIONS, 'CONCLUSIONS);
00300
00310
00320 FEXPR PQUESTIONS (INF); PLISTF(CAR INF, 'QUESTIONS, 'QUESTIONS);
00330
00340
00350 EXPR PDEDUCTIONS (); PLISTF('SELF, 'DEDUCTIONS, 'STATEMENTS);
00360
00370
00380 EXPR PLISTF (INF, IDENTIFICATION, IND);
00390 BEGIN NEW L;
00400 PRINT IDENTIFICATION;
00410 FOR NEW CONCEPT IN CONCEPT_LIST OF 'PERSONS DO
00420 FOR NEW I IN CONCEPT GET IND DO
00430 IF LAST_ATOM(I) EQ INF & I NOTIN L THEN L ← I CONS L
00440 ALSO PRINT IF IND EQ 'STATEMENTS THEN I↑4 @ STRENGTH CREDF(I) CONS I↓5 ELSE I;
00450 % THIS PREVENTS THE SENTENCE'S BEING PRINTED OUT BY BOTH THE SUBJECT AND THE OBJECT. %
00460 TERPRI NIL
00470 END;
00480
00490
00500 FEXPR PABOUT (CONCEPT);
00510 BEGIN NEW X;
00520 CONCEPT ← CAR CONCEPT;
00530 IF CONCEPT NOTIN (CONCEPT_LIST OF 'PERSONS) THEN
00540 RETURN TPRINTSTR("NOTHING IS KNOWN ABOUT " CAT CONCEPT);
00550 TPRINTSTR("***** EVERYTHING KNOWN ABOUT " CAT CONCEPT CAT " *****");
00560 FOR NEW IND IN MAIN_INDICATORS OF 'PERSONS @ LEGALCATLIST OF 'PERSONS DO
00570 IF X ← CONCEPT GET IND THEN
00580 BEGIN
00590 PRINT IND;
00600 IF ATOM X THEN PRINT X ELSE
00610 FOR NEW I IN X DO
00620 PRINT IF IND EQ 'STATEMENTS THEN I↑4 @ STRENGTH CREDF(I) CONS I↓5 ELSE I;
00630 TERPRI NIL
00640 END
00650 END;
00660
00670
00680 FEXPR PVARIABLES (INF);
00690 BEGIN
00700 INF ← CAR INF;
00710 PRINT 'VARIABLES;
00720 TERPRI PRINT(VARIABLES OF INF);
00730 FOR NEW VARNAME IN VARIABLES OF INF DO
00740 BEGIN
00750 PRINT VARNAME;
00760 TERPRI PRINT(VARIABLE OF VARNAME) % THE VARIABLE DEFINITION. %
00770 END
00780 END;
00790
00800
00810 FEXPR PSETS (INF);
00820 BEGIN
00830 INF ← CAR INF;
00840 PRINT 'SETS;
00850 TERPRI PRINT(SETS OF INF);
00860 FOR NEW SET_NAME IN SETS OF INF DO
00870 BEGIN
00880 PRINT SET_NAME;
00890 TERPRI PRINT(SET OF SET_NAME)
00900 END
00910 END;
00920
00930
00940 FEXPR PCRED (INF);
00950 BEGIN
00960 INF ← CAR INF;
00970 TPRINTSTR "CREDIBILITIES";
00980 FOR NEW CATEGORY IN LEGALCATLIST OF 'PERSONS DO PCRED1(INF, CATEGORY, INDF CATEGORY);
00990 TERPRI PCRED1(INF, 'GLOBALCRED, 'GLOBALCRED)
01000 END;
01010
01020
01030 EXPR PCRED1 (INF, CATEGORY, CREDIND);
01040 PRINTSTR(CATEGORY CAT SUBSTR(": ", 1, 12 - LENGTH EXPLODEC CATEGORY) CAT STRENGTH(INF GET CREDIND));
01050
01060
01070 EXPR PCATEGORIES ();
01080 BEGIN
01090 TPRINTSTR "CATEGORIES";
01100 FOR NEW CATGY IN LEGALCATLIST OF 'PERSONS DO
01110 BEGIN
01120 PRINT CATGY;
01130 TERPRI PRINT(CATEGORY OF CATGY)
01140 END
01150 END;
01160
01170
01180 EXPR PDATA (); DUMP_DATA(LPT:);
01190
01200
01210 EXPR PALL ();
01220 BEGIN
01230 OUTC(OUTPUT(FOO, LPT:), NIL);
01250 FOR NEW CONCEPT IN CONCEPT_LIST OF 'PERSONS DO TERPRI TERPRI EVAL <'PABOUT, CONCEPT>;
01260 OUTC(NIL,T);
01270 RETURN 'FINISHED
01280 END;
01290
01300
01310 EXPR PBOTH (); PDATA() PROG2 PALL();
01320
01330
01340 FEXPR DUMP_DATA (L);
01350 % THE ARGUMENTS TO DUMP_DATA ARE EXACTLY THE SAME AS THOSE TO RESTORE_DATA. %
01360 BEGIN
01375 IF L THEN
01380 IF CDR L | CAR L EQ 'LPT: THEN EVAL('OUTPUT CONS 'FOO CONS L)
01385 ELSE EVAL <'OUTPUT, 'FOO, 'DSK:, CAR L>
01390 ELSE OUTPUT(FOO, DSK:, DATA);
01400 OUTC(FOO,NIL);
01410 PCONCEPTS();
01420 FOR NEW P IN PLIST OF 'PERSONS DO
01430 BEGIN
01440 EVAL <'PSAYS, P>;
01450 PRINT 'AASLIST; TERPRI FOR NEW I IN AASLIST OF P DO PRINT I;
01460 PRINT 'AALIST; TERPRI FOR NEW I IN AALIST OF P DO PRINT I;
01470 EVAL <'PVARIABLES, P>;
01480 EVAL <'PSETS, P>;
01490 EVAL <'PCRED, P>
01500 END;
01510 PCATEGORIES();
01520 PRINT 'END;
01530 OUTC(NIL,T);
01540 RETURN 'FINISHED
01550 END;
00010 %##############################################################################################################%
00020 %####################################### THE SCANNER ########################################%
00030 %##############################################################################################################%
00040
00050 EXPR READ_SENTENCE (TOKEN);
00060 BEGIN NEW !SENT;
00070 SPECIAL !SENT;
00080 !SENT ← ANALYZE(TOKEN CONS READ_SENTENCE1 SCANNER !NEXTCHAR);
00090 IF !SENT EQ 'ERROR THEN RETURN 'ERROR;
00100 IF !TERMINATOR EQ 'IMPLIES THEN
00110 BEGIN NEW SENT1;
00120 SENT1 ← ANALYZE READ_SENTENCE1 SCANNER !NEXTCHAR;
00130 IF SENT1 EQ 'ERROR THEN !SENT ← SENT1 ELSE !SENT ← <REPLACE_ALL(!SENT, NIL), REPLACE_ALL(SENT1, NIL)>
00140 END
00150 ELSE !SENT ← REPLACE_ALL(!SENT, T);
00160 IF !SENT EQ 'ERROR THEN RETURN 'ERROR;
00170 IF !TERMINATOR EQ '?? THEN !QFLAG ← T ELSE
00180 IF !TERMINATOR EQ PERIOD THEN
00190 IF LENGTH !SENT = 2 THEN !RFLAG ← T ELSE !SFLAG ← T
00200 ELSE PRINTSTR("ILLEGAL BREAK CHARACTER: " CAT !TERMINATOR);
00210 RETURN !SENT
00220 END;
00230
00240
00250 EXPR READ_SENTENCE1 (TOKEN);
00260 IF GET(TOKEN,'TERMIN) THEN !TERMINATOR ← TOKEN ALSO NIL ELSE TOKEN CONS READ_SENTENCE1 SCANNER !NEXTCHAR;
00270
00280
00290 EXPR SCANNER (CHAR);
00300 IF NUMBERP CHAR | GET(CHAR,'LETTER) THEN READLIST(CHAR CONS SCAN1 IO(READCH(),"")) ELSE
00310 IF GET(CHAR,'NULLSYM) THEN SCANNER IO(READCH(),"")
00320 ELSE !NEXTCHAR ← BLANK_SKIP IO(READCH(),"") ALSO CHAR;
00330
00340
00350 EXPR SCAN1 (CHAR);
00360 % 'NEXTCHAR' GETS SET TO THE FIRST NON-BLANK CHARACTER AFTER EVERY WORD. %
00370 IF NUMBERP CHAR | GET(CHAR,'LETTER) THEN CHAR CONS SCAN1 IO(READCH(),"")
00380 ELSE !NEXTCHAR ← BLANK_SKIP CHAR ALSO NIL;
00390
00400
00410 EXPR BLANK_SKIP (CHAR); IF CHAR EQ BLANK THEN BLANK_SKIP IO(READCH(),"") ELSE CHAR;
00420
00430
00440 EXPR ANALYZE (L);
00450 BEGIN NEW X, Y, Z, V;
00460 IF NULL L THEN RETURN 'ERROR;
00470 X ← GET_SUBJECT(CAR L, CDR L, NIL); % GET_SUBJECT RETURNS ((SUBJECT FIELD) (REST OF SENTENCE)). %
00480 IF X EQ 'ERROR | ¬ Z←X[2] THEN RETURN 'ERROR;
00490 Y ← GET_VERB(CAR Z, CDR Z, NIL); % GET_VERB RETURNS ((VERB FIELD) (OBJECT FIELD)). %
00500 IF Y EQ 'ERROR THEN RETURN 'ERROR ELSE
00510 IF MODAL OF CAR V ← Y[1] THEN
00520 % THIS CHANGES (CERTAINLY IS A) TO (IS CERTAINLY A). %
00530 IF CDR V THEN V ← V[2] CONS V[1] CONS V↓2 ELSE RETURN 'ERROR;
00540 RETURN <JOIN X[1], V, JOIN Y[2], <NIL,NIL>>
00550 END;
00560
00570
00580 EXPR GET_SUBJECT (NEXT, REST, X);
00590 IF NULL REST THEN 'ERROR ELSE
00600 IF GET(NEXT,'VERB) THEN % THIS HANDLES INVERTED VERB FORMS. %
00610 X ← GET_SUBJECT1(REST[2], REST↓2, NIL, T)
00620 ALSO IF X EQ 'ERROR THEN 'ERROR ELSE <CAR REST CONS X[1], NEXT CONS X[2]>
00630 ELSE GET_SUBJECT1(NEXT, REST, NIL, NIL);
00640
00650
00660 EXPR GET_SUBJECT1 (NEXT, REST, L, INVERTED);
00670 IF GET(NEXT,'VERB) | INVERTED & GET(NEXT,'AUX) THEN <REVERSE L, NEXT CONS REST> ELSE
00680 IF NULL REST THEN 'ERROR
00690 % ERROR, SINCE THERE IS NOTHING LEFT IN THE SENTENCE AND WE STILL HAVEN'T FOUND THE VERB. %
00700 ELSE GET_SUBJECT1(CAR REST, CDR REST, NEXT CONS L, INVERTED);
00710
00720
00730 EXPR GET_VERB (NEXT, REST, L);
00740 IF GET(NEXT,'AUX) | GET(NEXT,'VERB) THEN
00750 IF NULL REST THEN 'ERROR % ERROR, SINCE WE STILL HAVEN'T FOUND THE OBJECT. %
00760 ELSE GET_VERB(CAR REST, CDR REST, NEXT CONS L)
00770 ELSE <REVERSE L, NEXT CONS REST>;
00780
00790
00800 EXPR REPLACE_ALL (S, BOTH);
00810 % REPLACE_ALL REPLACES ALL OCCURRENCES IN 'S' OF ANY SET ELEMENT IN ANY SET IN THE SYSTEM
00820 WITH THE CORRESPONDING SET NAME. REPLACE_ALL ONLY GETS CALLED BY READ_SENTENCE. %
00830 BEGIN NEW CONCEPT_LIST;
00840 CONCEPT_LIST ← IF BOTH THEN <SUBJ(S), OBJ(S)> ELSE <OBJ(S)>;
00850 FOR NEW P IN PLIST OF 'PERSONS DO
00860 FOR NEW SET_NAME IN SETS OF P DO
00870 FOR NEW HALF IN CONCEPT_LIST DO
00880 FOR NEW EL IN SET OF SET_NAME DO
00890 BEGIN NEW PAIR, NEW_CONCEPT;
00900 PAIR ← REP(EL, LENGTH EL, SET_NAME, HALF, 0);
00910 NEW_CONCEPT ← CAR PAIR;
00920 IF NEW_CONCEPT NEQ HALF THEN S ← REPLACE(HALF, NEW_CONCEPT, S, JOIN EL, CDR PAIR)
00930 END;
00940 RETURN S
00950 END;
00010 %##############################################################################################################%
00020 %################################# INITIALIZATION ROUTINES ##################################%
00030 %##############################################################################################################%
00040
00050 EXPR MARKIT ();
00060 BEGIN
00070 MARK('(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
00080 a b c d e f g h i j k l m n o p q r s t u v w x y z ?'), 'LETTER);
00090 MARK('(IS ARE WAS WERE SEEM SEEMS SEEMED BECOME BECOMES BECAME FEEL FEELS FELT APPEAR APPEARS APPEARED
00100 WILL COULD WOULD SHOULD OUGHT MUST CAN SHALL CERTAINLY PROBABLY POSSIBLY), 'VERB);
00110 MARK('(A AN NOT BE TO THE CERTAINLY PROBABLY POSSIBLY), 'AUX);
00120 MARK('(ABOUT AFTER AGAINST AMONG AT BEFORE BETWEEN BY DOWN DURING FOR FROM IN INTO LIKE OF OFF ON
00130 OUT OVER THROUGH TO TOWARDS UNDER UNTIL UP WITH WITHOUT), 'PREP);
00140 MARK('(CERTAINLY PROBABLY POSSIBLY), 'MODAL);
00150
00160 % 'LEGALCAT' CONTAINS ALL THE CONCEPT CATEGORIES (OR CLASSES) INTO WHICH THE STATEMENTS ARE SEPARATED.
00170 THIS IS THE ONLY STATEMENT WHICH HAS TO BE CHANGED TO ALTER THE SET OF ALLOWED CATEGORIES. %
00180 !LEGALCAT ← '(POLITICS RELIGION WAR RACE PERSONS MEDICINE OTHER);
00190 MARK(!LEGALCAT, 'LEGALCAT);
00200
00210 % LEGALCRED CONTAINS THE CREDIBILITY INDICATORS ASSOCIATED WITH THE DIFFERENT CATEGORIES. %
00220 !LEGALCRED ← FOR NEW I IN !LEGALCAT COLLECT <PUTPROP(I, AT(I CAT "CRED"), 'CREDINDICATOR)>;
00230
00240 % UNDER THE ATOM 'PERSONS' IS STORED THE:
00250 (1) PLIST -- LIST OF INFORMANTS WHO HAVE TALKED TO RALPH
00260 (2) CONCEPT_LIST -- LIST OF ALL THE CONCEPTS THAT HAVE BEEN DISCUSSED
00270 (3) LEGALCATLIST -- LIST OF THE LEGAL CATEGORIES
00280 (4) LEGALCREDLIST -- LIST OF THE LEGAL CREDIBILITY INDICATORS
00290 (5) MAIN_INDICATORS -- LIST OF THE MAIN INDICATORS: (STATEMENTS RULES CONCLUSIONS QUESTIONS)
00300 %
00310 PUTPROP('PERSONS, !LEGALCAT, 'LEGALCATLIST);
00320 PUTPROP('PERSONS, !LEGALCRED, 'LEGALCREDLIST);
00330 PUTPROP('PERSONS, '(STATEMENTS RULES CONCLUSIONS QUESTIONS), 'MAIN_INDICATORS);
00340 MARK(<'IMPLIES, PERIOD, '??>, 'TERMIN);
00350 MARK(<BLANK, CR, LF, COMMA, ALTMODE>, 'NULLSYM);
00360 MARK(<PERIOD, ALTMODE, CR>, 'ENDER);
00370 !INFERENCE_MAX ← 3; % THIS IS THE BACKWARD-CHAINING DEPTH. %
00380 PRINC "ALPHA = "; !ALPHA ← READ(); % 0.40 IS STANDARD. %
00390 PRINC "OMEGA = "; !OMEGA ← READ(); % 0.80 IS STANDARD. %
00400 !OMEGA_FACTOR ← (1 - !OMEGA) / !OMEGA; % USED IN 'FORM_CREDIBILITIES1'. %
00410 !CRAT ← T; % "CRAT" STANDS FOR "COMPUTE RATIO". %
00415 !CRLF ← CR CAT LF; % <CARRIAGE RETURN> <LINE FEED> %
00420 DEFPROP(X, T, CATEGORIZED); % DON'T ASK THE POOR INFORMANT TO CATEGORIZE 'X'. %
00430 INITIALIZE(); % INITIALIZE THE WORLD. %
00435 DEFPROP(DATA, T, MARKED); % DATA ALL MARKED. %
00440 END;
00450
00460
00470 EXPR MARK (L, SPECIAL !IND); MAPCAR(FUNCTION(LAMBDA(A); PUTPROP(A, T, !IND)), L);
00480
00490
00500 EXPR INITIALIZE ();
00510 BEGIN
00520 FOR NEW P IN PLIST OF 'PERSONS DO % REMOVE ALL THE PROPERTIES FROM EACH PERSON. %
00530 BEGIN
00540 FOR NEW SET IN SETS OF P DO REMPROP(SET, 'SET);
00550 FOR NEW IND IN <'SETS, 'NEW_STATEMENTS, 'AALIST, 'AASLIST, 'GLOBALCRED> @ LEGALCREDLIST OF 'PERSONS DO
00560 REMPROP(P, IND)
00570 END;
00580 FOR NEW CONCEPT IN CONCEPT_LIST OF 'PERSONS DO % REMOVE ALL THE PROPERTIES FROM EACH CONCEPT. %
00590 FOR NEW IND IN '(SLENGTH CATEGORIZED) @ MAIN_INDICATORS OF 'PERSONS @ LEGALCATLIST OF 'PERSONS DO
00600 REMPROP(CONCEPT, IND);
00610 FOR NEW CATEGORY IN LEGALCATLIST OF 'PERSONS DO REMPROP(CATEGORY, 'CATEGORY);
00620 REMPROP('PERSONS, 'PLIST); % ZERO THE PLIST. %
00630 REMPROP('PERSONS, 'CONCEPT_LIST); % ZERO THE CONCEPT_LIST. %
00640 STORE_PERSON('SELF, 60.0) % PUT 'SELF' ON THE PLIST. %
00650 END;
00660
00670
00680 EXPR IO (X,S);
00690 IF !SAVE THEN % WE'RE SAVING THIS CONVERSATION ON THE DISK. %
00700 BEGIN
00710 OUTC(T,NIL);
00720 PRINC X; PRINC S;
00730 OUTC(NIL,NIL);
00740 RETURN X
00750 END ELSE
00760 IF !USE THEN PRINC X ALSO PRINC S ALSO X % WE'RE USING A CONVERSATION ALREADY ON THE DISK. %
00780 ELSE X;
00790
00800
00810 EXPR SWAP_FILES ();
00820 BEGIN
00840 EVAL <'INC, <'INPUT, 'DSK:, !FILES[1]>, NIL>;
00850 EVAL <'OUTC, <'OUTPUT, 'DSK:, !FILES[2]>, NIL>;
00860 DO NIL UNTIL ATOM ERRSET(TYO TYI(), T);
00870 INC(NIL,T);
00880 OUTC(NIL,NIL); % LEAVE THE NEW OUTPUT FILE OPEN. %
00890 !FILES ← REVERSE !FILES % SWAP THE OUTPUT FILE NAMES. %
00900 END;
00010 %##############################################################################################################%
00020 %################################## EXECUTION BEGINS HERE ###################################%
00030 %##############################################################################################################%
00040
00050
00055 IF ¬GET('DATA,'MARKED) THEN MARKIT();
00060 PRINTSTR TERPRI "DO YOU WANT TO SAVE THIS CONVERSATION ON THE DISK? (YES OR NO)";
00070 IF READ() EQ 'YES THEN
00080 BEGIN NEW FILE;
00090 !SAVE ← T; % ONLY ONE OF !SAVE,!USE MAY BE SET AT ANY ONE TIME. %
00100 PRINTSTR TERPRI "FILE NAME?";
00110 EVAL <'OUTPUT, 'DSK:, FILE ← READ()>;
00120 !FILES ← <FILE, FILE CONS 1>; % USE FILENAME.1 FOR THE ALTERNATE FILE NAME. %
00130 END
00140 ELSE BEGIN
00150 PRINTSTR TERPRI "DO YOU WANT TO USE A CONVERSATION ALREADY ON THE DISK? (YES OR NO)";
00160 IF READ() EQ 'NO THEN RETURN NIL;
00170 !USE ← T;
00180 PRINTSTR TERPRI "FILE NAME?";
00190 EVAL <'INC, <'INPUT, 'DSK:, READ()>, NIL>;
00200 TPRINTSTR TERPRI "OK, HERE WE GO."
00210 END;
00220
00230
00240 PRINTSTR TERPRI "END ALL LINES WITH A CARRIAGE RETURN OR ALTMODE.
00250 TYPE START";
00260 !INPUT ← IO(READ(), !CRLF);
00270
00280 WHILE !INPUT NEQ 'END DO
00290 BEGIN
00300 WHILE !INPUT NEQ 'START & !INPUT NEQ 'END DO (PRINT EVAL !INPUT) PROG2 !INPUT ← IO(READ(), !CRLF);
00310 IF !INPUT EQ 'START THEN
00320 BEGIN
00330 PRINTSTR TERPRI "HELLO. PLEASE TYPE YOUR FIRST NAME.";
00340 !INFORMANT ← IO(READ(), !CRLF);
00350 TALK_TIME !INFORMANT;
00360 QUESTION_TIME !INFORMANT;
00370 THINK_TIME !INFORMANT;
00380 OUTC(NIL,NIL); % MAKE SURE WE'RE PRINTING ONTO THE TELETYPE. %
00390 TERPRI EVAL TERPRI <'PCRED, !INFORMANT>; % SHOW HIM HIS CREDIBILITIES. %
00400 IF !SAVE THEN SWAP_FILES(); % SWAP THE OUTPUT FILES IN CASE THE SYSTEM GOES DOWN. %
00410 PRINTSTR "THANK YOU. NOW TYPE START OR END.";
00411 IF !USE THEN
00412 IF ATOM !INPUT ← ERRSET(IO(READ(), !CRLF), T) THEN INC(NIL,T) ALSO !INPUT ← IO(READ(), !CRLF)
00413 ELSE !INPUT ← CAR !INPUT
00414 ELSE !INPUT ← IO(READ(), !CRLF);
00430 END
00440 END;
00450
00460
00470 IF !SAVE THEN OUTC(T,NIL) ALSO OUTC(NIL,T) % CLOSE THE SAVE FILE. %
00480
00490 END.
00590 ?$EOF?$